{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Api.Internal.Query.Expr
  ( queryAccountState
  , queryChainBlockNo
  , queryChainPoint
  , queryConstitution
  , queryCurrentEpochState
  , queryCurrentEra
  , queryDebugLedgerState
  , queryEpoch
  , queryConstitutionHash
  , queryEraHistory
  , queryGenesisParameters
  , queryPoolDistribution
  , queryPoolState
  , queryProtocolParameters
  , queryProtocolState
  , queryStakeAddresses
  , queryStakeDelegDeposits
  , queryStakeDistribution
  , queryStakePoolParameters
  , queryStakePools
  , queryStakeSnapshot
  , querySystemStart
  , queryUtxo
  , queryLedgerPeerSnapshot
  , L.MemberStatus (..)
  , L.CommitteeMembersState (..)
  , queryCommitteeMembersState
  , queryDRepStakeDistribution
  , querySPOStakeDistribution
  , queryDRepState
  , queryGovState
  , queryRatifyState
  , queryFuturePParams
  , queryStakeVoteDelegatees
  , queryProposals
  , queryStakePoolDefaultVote
  , queryLedgerConfig
  )
where

import Cardano.Api.Internal.Address
import Cardano.Api.Internal.Block
import Cardano.Api.Internal.Certificate
import Cardano.Api.Internal.Eon.BabbageEraOnwards
import Cardano.Api.Internal.Eon.Convert
import Cardano.Api.Internal.Eon.ConwayEraOnwards
import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.Eras
import Cardano.Api.Internal.GenesisParameters
import Cardano.Api.Internal.IPC
import Cardano.Api.Internal.IPC.Monad
import Cardano.Api.Internal.Keys.Shelley
import Cardano.Api.Internal.NetworkId
import Cardano.Api.Internal.Query
import Cardano.Api.Internal.ReexposeLedger qualified as Ledger
import Cardano.Api.Internal.Tx.UTxO
import Cardano.Api.Internal.Utils ((<<<$>>>))

import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Api.State.Query qualified as L
import Cardano.Ledger.CertState qualified as L
import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Credential qualified as L
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)

import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.Set qualified as S

queryChainBlockNo
  :: ()
  => LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
queryChainBlockNo :: forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
queryChainBlockNo =
  QueryInMode (WithOrigin BlockNo)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr QueryInMode (WithOrigin BlockNo)
QueryChainBlockNo

queryChainPoint
  :: ()
  => LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError ChainPoint)
queryChainPoint :: forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError ChainPoint)
queryChainPoint =
  QueryInMode ChainPoint
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError ChainPoint)
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr QueryInMode ChainPoint
QueryChainPoint

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

queryCurrentEra
  :: ()
  => LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra :: forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra =
  QueryInMode AnyCardanoEra
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError AnyCardanoEra)
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr QueryInMode AnyCardanoEra
QueryCurrentEra

queryCurrentEpochState
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedCurrentEpochState era)))
queryCurrentEpochState :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedCurrentEpochState era)))
queryCurrentEpochState ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedCurrentEpochState era)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
forall era.
QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
QueryCurrentEpochState

queryEpoch
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch EpochNo))
queryEpoch :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch EpochNo))
queryEpoch ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era EpochNo
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch EpochNo))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era EpochNo
forall era. QueryInShelleyBasedEra era EpochNo
QueryEpoch

queryDebugLedgerState
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedDebugLedgerState era)))
queryDebugLedgerState :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedDebugLedgerState era)))
queryDebugLedgerState ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedDebugLedgerState era)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState

queryLedgerPeerSnapshot
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (Serialised LedgerPeerSnapshot)))
queryLedgerPeerSnapshot :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Serialised LedgerPeerSnapshot)))
queryLedgerPeerSnapshot ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Serialised LedgerPeerSnapshot)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Serialised LedgerPeerSnapshot)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (Serialised LedgerPeerSnapshot)
forall era.
QueryInShelleyBasedEra era (Serialised LedgerPeerSnapshot)
QueryLedgerPeerSnapshot

queryEraHistory
  :: ()
  => LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError EraHistory)
queryEraHistory :: forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError EraHistory)
queryEraHistory =
  QueryInMode EraHistory
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError EraHistory)
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr QueryInMode EraHistory
QueryEraHistory

queryGenesisParameters
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (GenesisParameters ShelleyEra)))
queryGenesisParameters :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GenesisParameters ShelleyEra)))
queryGenesisParameters ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GenesisParameters ShelleyEra)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
forall era.
QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
QueryGenesisParameters

queryPoolDistribution
  :: ()
  => BabbageEraOnwards era
  -> Maybe (Set PoolId)
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolDistribution era)))
queryPoolDistribution :: forall era block point r.
BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolDistribution era)))
queryPoolDistribution BabbageEraOnwards era
eon = BabbageEraOnwards era
-> QueryInShelleyBasedEra era (SerialisedPoolDistribution era)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolDistribution era)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe BabbageEraOnwards era
eon (QueryInShelleyBasedEra era (SerialisedPoolDistribution era)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (SerialisedPoolDistribution era))))
-> (Maybe (Set PoolId)
    -> QueryInShelleyBasedEra era (SerialisedPoolDistribution era))
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolDistribution era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Set PoolId)
-> QueryInShelleyBasedEra era (SerialisedPoolDistribution era)
forall era.
Maybe (Set PoolId)
-> QueryInShelleyBasedEra era (SerialisedPoolDistribution era)
QueryPoolDistribution

queryPoolState
  :: ()
  => BabbageEraOnwards era
  -> Maybe (Set PoolId)
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolState era)))
queryPoolState :: forall era block point r.
BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolState era)))
queryPoolState BabbageEraOnwards era
eon = BabbageEraOnwards era
-> QueryInShelleyBasedEra era (SerialisedPoolState era)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolState era)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe BabbageEraOnwards era
eon (QueryInShelleyBasedEra era (SerialisedPoolState era)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (SerialisedPoolState era))))
-> (Maybe (Set PoolId)
    -> QueryInShelleyBasedEra era (SerialisedPoolState era))
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolState era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Set PoolId)
-> QueryInShelleyBasedEra era (SerialisedPoolState era)
forall era.
Maybe (Set PoolId)
-> QueryInShelleyBasedEra era (SerialisedPoolState era)
QueryPoolState

queryProtocolParameters
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (Ledger.PParams (ShelleyLedgerEra era))))
queryProtocolParameters :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
queryProtocolParameters ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
QueryProtocolParameters

queryConstitutionHash
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       ( Either
           UnsupportedNtcVersionError
           (Either EraMismatch (SafeHash L.AnchorData))
       )
queryConstitutionHash :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SafeHash AnchorData)))
queryConstitutionHash ShelleyBasedEra era
eon =
  (Anchor -> SafeHash AnchorData
L.anchorDataHash (Anchor -> SafeHash AnchorData)
-> (Constitution (ShelleyLedgerEra era) -> Anchor)
-> Constitution (ShelleyLedgerEra era)
-> SafeHash AnchorData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constitution (ShelleyLedgerEra era) -> Anchor
forall era. Constitution era -> Anchor
L.constitutionAnchor)
    (Constitution (ShelleyLedgerEra era) -> SafeHash AnchorData)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SafeHash AnchorData)))
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a b.
(Functor f, Functor g, Functor h) =>
(a -> b) -> f (g (h a)) -> f (g (h b))
<<<$>>> ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Constitution (ShelleyLedgerEra era))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (Constitution (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (Constitution (ShelleyLedgerEra era))
QueryConstitution

queryProtocolState
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (ProtocolState era)))
queryProtocolState :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ProtocolState era)))
queryProtocolState ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (ProtocolState era)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ProtocolState era)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (ProtocolState era)
forall era. QueryInShelleyBasedEra era (ProtocolState era)
QueryProtocolState

queryStakeAddresses
  :: ()
  => ShelleyBasedEra era
  -> Set StakeCredential
  -> NetworkId
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       ( Either
           UnsupportedNtcVersionError
           (Either EraMismatch (Map StakeAddress L.Coin, Map StakeAddress PoolId))
       )
queryStakeAddresses :: forall era block point r.
ShelleyBasedEra era
-> Set StakeCredential
-> NetworkId
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Coin, Map StakeAddress PoolId)))
queryStakeAddresses ShelleyBasedEra era
eon Set StakeCredential
stakeCredentials NetworkId
networkId = ShelleyBasedEra era
-> QueryInShelleyBasedEra
     era (Map StakeAddress Coin, Map StakeAddress PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Coin, Map StakeAddress PoolId)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon (QueryInShelleyBasedEra
   era (Map StakeAddress Coin, Map StakeAddress PoolId)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either
            EraMismatch (Map StakeAddress Coin, Map StakeAddress PoolId))))
-> QueryInShelleyBasedEra
     era (Map StakeAddress Coin, Map StakeAddress PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Coin, Map StakeAddress PoolId)))
forall a b. (a -> b) -> a -> b
$ Set StakeCredential
-> NetworkId
-> QueryInShelleyBasedEra
     era (Map StakeAddress Coin, Map StakeAddress PoolId)
forall era.
Set StakeCredential
-> NetworkId
-> QueryInShelleyBasedEra
     era (Map StakeAddress Coin, Map StakeAddress PoolId)
QueryStakeAddresses Set StakeCredential
stakeCredentials NetworkId
networkId

queryStakeDelegDeposits
  :: BabbageEraOnwards era
  -> Set StakeCredential
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either Consensus.EraMismatch (Map StakeCredential L.Coin)))
queryStakeDelegDeposits :: forall era block point r.
BabbageEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
queryStakeDelegDeposits BabbageEraOnwards era
eon Set StakeCredential
stakeCreds
  | Set StakeCredential -> Bool
forall a. Set a -> Bool
S.null Set StakeCredential
stakeCreds = Either
  UnsupportedNtcVersionError
  (Either EraMismatch (Map StakeCredential Coin))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
forall a. a -> LocalStateQueryExpr block point QueryInMode r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   UnsupportedNtcVersionError
   (Either EraMismatch (Map StakeCredential Coin))
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map StakeCredential Coin))))
-> (Either EraMismatch (Map StakeCredential Coin)
    -> Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map StakeCredential Coin)))
-> Either EraMismatch (Map StakeCredential Coin)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either EraMismatch (Map StakeCredential Coin)
-> Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Map StakeCredential Coin))
forall a. a -> Either UnsupportedNtcVersionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EraMismatch (Map StakeCredential Coin)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map StakeCredential Coin))))
-> Either EraMismatch (Map StakeCredential Coin)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
forall a b. (a -> b) -> a -> b
$ Map StakeCredential Coin
-> Either EraMismatch (Map StakeCredential Coin)
forall a. a -> Either EraMismatch a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map StakeCredential Coin
forall a. Monoid a => a
mempty
  | Bool
otherwise = BabbageEraOnwards era
-> QueryInShelleyBasedEra era (Map StakeCredential Coin)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe BabbageEraOnwards era
eon (QueryInShelleyBasedEra era (Map StakeCredential Coin)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map StakeCredential Coin))))
-> QueryInShelleyBasedEra era (Map StakeCredential Coin)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
forall a b. (a -> b) -> a -> b
$ Set StakeCredential
-> QueryInShelleyBasedEra era (Map StakeCredential Coin)
forall era.
Set StakeCredential
-> QueryInShelleyBasedEra era (Map StakeCredential Coin)
QueryStakeDelegDeposits Set StakeCredential
stakeCreds

queryStakeDistribution
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (Map (Hash StakePoolKey) Rational)))
queryStakeDistribution :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId Rational)))
queryStakeDistribution ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Map PoolId Rational)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId Rational)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (Map PoolId Rational)
forall era. QueryInShelleyBasedEra era (Map PoolId Rational)
QueryStakeDistribution

queryStakePoolParameters
  :: ()
  => ShelleyBasedEra era
  -> Set PoolId
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (Map PoolId StakePoolParameters)))
queryStakePoolParameters :: forall era block point r.
ShelleyBasedEra era
-> Set PoolId
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId StakePoolParameters)))
queryStakePoolParameters ShelleyBasedEra era
eon Set PoolId
poolIds
  | Set PoolId -> Bool
forall a. Set a -> Bool
S.null Set PoolId
poolIds = Either
  UnsupportedNtcVersionError
  (Either EraMismatch (Map PoolId StakePoolParameters))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId StakePoolParameters)))
forall a. a -> LocalStateQueryExpr block point QueryInMode r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   UnsupportedNtcVersionError
   (Either EraMismatch (Map PoolId StakePoolParameters))
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map PoolId StakePoolParameters))))
-> (Either EraMismatch (Map PoolId StakePoolParameters)
    -> Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map PoolId StakePoolParameters)))
-> Either EraMismatch (Map PoolId StakePoolParameters)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId StakePoolParameters)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either EraMismatch (Map PoolId StakePoolParameters)
-> Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Map PoolId StakePoolParameters))
forall a. a -> Either UnsupportedNtcVersionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EraMismatch (Map PoolId StakePoolParameters)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map PoolId StakePoolParameters))))
-> Either EraMismatch (Map PoolId StakePoolParameters)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId StakePoolParameters)))
forall a b. (a -> b) -> a -> b
$ Map PoolId StakePoolParameters
-> Either EraMismatch (Map PoolId StakePoolParameters)
forall a. a -> Either EraMismatch a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map PoolId StakePoolParameters
forall a. Monoid a => a
mempty
  | Bool
otherwise =
      ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Map PoolId StakePoolParameters)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId StakePoolParameters)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon (QueryInShelleyBasedEra era (Map PoolId StakePoolParameters)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map PoolId StakePoolParameters))))
-> QueryInShelleyBasedEra era (Map PoolId StakePoolParameters)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId StakePoolParameters)))
forall a b. (a -> b) -> a -> b
$ Set PoolId
-> QueryInShelleyBasedEra era (Map PoolId StakePoolParameters)
forall era.
Set PoolId
-> QueryInShelleyBasedEra era (Map PoolId StakePoolParameters)
QueryStakePoolParameters Set PoolId
poolIds

queryStakePools
  :: ()
  => ShelleyBasedEra era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
queryStakePools :: forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
queryStakePools ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon QueryInShelleyBasedEra era (Set PoolId)
forall era. QueryInShelleyBasedEra era (Set PoolId)
QueryStakePools

queryStakeSnapshot
  :: ()
  => BabbageEraOnwards era
  -> Maybe (Set PoolId)
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedStakeSnapshots era)))
queryStakeSnapshot :: forall era block point r.
BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedStakeSnapshots era)))
queryStakeSnapshot BabbageEraOnwards era
eon = BabbageEraOnwards era
-> QueryInShelleyBasedEra era (SerialisedStakeSnapshots era)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedStakeSnapshots era)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe BabbageEraOnwards era
eon (QueryInShelleyBasedEra era (SerialisedStakeSnapshots era)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (SerialisedStakeSnapshots era))))
-> (Maybe (Set PoolId)
    -> QueryInShelleyBasedEra era (SerialisedStakeSnapshots era))
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedStakeSnapshots era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Set PoolId)
-> QueryInShelleyBasedEra era (SerialisedStakeSnapshots era)
forall era.
Maybe (Set PoolId)
-> QueryInShelleyBasedEra era (SerialisedStakeSnapshots era)
QueryStakeSnapshot

querySystemStart
  :: ()
  => LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError SystemStart)
querySystemStart :: forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError SystemStart)
querySystemStart =
  QueryInMode SystemStart
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError SystemStart)
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr QueryInMode SystemStart
QuerySystemStart

queryUtxo
  :: ()
  => ShelleyBasedEra era
  -> QueryUTxOFilter
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
queryUtxo :: forall era block point r.
ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
queryUtxo ShelleyBasedEra era
eon = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ShelleyBasedEra era
eon (QueryInShelleyBasedEra era (UTxO era)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError (Either EraMismatch (UTxO era))))
-> (QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era))
-> QueryUTxOFilter
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO

queryConstitution
  :: ()
  => ConwayEraOnwards era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (L.Constitution (ShelleyLedgerEra era))))
queryConstitution :: forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
queryConstitution ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra era (Constitution (ShelleyLedgerEra era))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon QueryInShelleyBasedEra era (Constitution (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (Constitution (ShelleyLedgerEra era))
QueryConstitution

queryGovState
  :: ()
  => ConwayEraOnwards era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (L.GovState (ShelleyLedgerEra era))))
queryGovState :: forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GovState (ShelleyLedgerEra era))))
queryGovState ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra era (GovState (ShelleyLedgerEra era))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GovState (ShelleyLedgerEra era))))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon QueryInShelleyBasedEra era (GovState (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (GovState (ShelleyLedgerEra era))
QueryGovState

queryRatifyState
  :: ()
  => ConwayEraOnwards era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (L.RatifyState (ShelleyLedgerEra era))))
queryRatifyState :: forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (RatifyState (ShelleyLedgerEra era))))
queryRatifyState ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra era (RatifyState (ShelleyLedgerEra era))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (RatifyState (ShelleyLedgerEra era))))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon QueryInShelleyBasedEra era (RatifyState (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (RatifyState (ShelleyLedgerEra era))
QueryRatifyState

queryFuturePParams
  :: ()
  => ConwayEraOnwards era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch (Maybe (L.PParams (ShelleyLedgerEra era)))))
queryFuturePParams :: forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Maybe (PParams (ShelleyLedgerEra era)))))
queryFuturePParams ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra
     era (Maybe (PParams (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Maybe (PParams (ShelleyLedgerEra era)))))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon QueryInShelleyBasedEra era (Maybe (PParams (ShelleyLedgerEra era)))
forall era.
QueryInShelleyBasedEra era (Maybe (PParams (ShelleyLedgerEra era)))
QueryFuturePParams

queryDRepState
  :: ConwayEraOnwards era
  -> Set (L.Credential L.DRepRole)
  -- ^ 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.DRepState))
       )
queryDRepState :: forall era block point r.
ConwayEraOnwards era
-> Set (Credential 'DRepRole)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
queryDRepState ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra
     era (Map (Credential 'DRepRole) DRepState)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon (QueryInShelleyBasedEra era (Map (Credential 'DRepRole) DRepState)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map (Credential 'DRepRole) DRepState))))
-> (Set (Credential 'DRepRole)
    -> QueryInShelleyBasedEra
         era (Map (Credential 'DRepRole) DRepState))
-> Set (Credential 'DRepRole)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'DRepRole)
-> QueryInShelleyBasedEra
     era (Map (Credential 'DRepRole) DRepState)
forall era.
Set (Credential 'DRepRole)
-> QueryInShelleyBasedEra
     era (Map (Credential 'DRepRole) DRepState)
QueryDRepState

queryDRepStakeDistribution
  :: ConwayEraOnwards era
  -> Set L.DRep
  -- ^ 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.Coin)))
queryDRepStakeDistribution :: forall era block point r.
ConwayEraOnwards era
-> Set DRep
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Map DRep Coin)))
queryDRepStakeDistribution ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra era (Map DRep Coin)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Map DRep Coin)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon (QueryInShelleyBasedEra era (Map DRep Coin)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError (Either EraMismatch (Map DRep Coin))))
-> (Set DRep -> QueryInShelleyBasedEra era (Map DRep Coin))
-> Set DRep
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Map DRep Coin)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set DRep -> QueryInShelleyBasedEra era (Map DRep Coin)
forall era. Set DRep -> QueryInShelleyBasedEra era (Map DRep Coin)
QueryDRepStakeDistr

querySPOStakeDistribution
  :: ConwayEraOnwards era
  -> Set (L.KeyHash 'L.StakePool)
  -- ^ An empty SPO key hash set means that distributions for all SPOs will be returned
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       ( Either
           UnsupportedNtcVersionError
           (Either EraMismatch (Map (L.KeyHash 'L.StakePool) L.Coin))
       )
querySPOStakeDistribution :: forall era block point r.
ConwayEraOnwards era
-> Set (KeyHash 'StakePool)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (KeyHash 'StakePool) Coin)))
querySPOStakeDistribution ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra era (Map (KeyHash 'StakePool) Coin)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (KeyHash 'StakePool) Coin)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon (QueryInShelleyBasedEra era (Map (KeyHash 'StakePool) Coin)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map (KeyHash 'StakePool) Coin))))
-> (Set (KeyHash 'StakePool)
    -> QueryInShelleyBasedEra era (Map (KeyHash 'StakePool) Coin))
-> Set (KeyHash 'StakePool)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (KeyHash 'StakePool) Coin)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (KeyHash 'StakePool)
-> QueryInShelleyBasedEra era (Map (KeyHash 'StakePool) Coin)
forall era.
Set (KeyHash 'StakePool)
-> QueryInShelleyBasedEra era (Map (KeyHash 'StakePool) Coin)
QuerySPOStakeDistr

-- | 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
  :: ConwayEraOnwards era
  -> Set (L.Credential L.ColdCommitteeRole)
  -> Set (L.Credential L.HotCommitteeRole)
  -> Set L.MemberStatus
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch L.CommitteeMembersState))
queryCommitteeMembersState :: forall era block point r.
ConwayEraOnwards era
-> Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch CommitteeMembersState))
queryCommitteeMembersState ConwayEraOnwards era
eon Set (Credential 'ColdCommitteeRole)
coldCreds Set (Credential 'HotCommitteeRole)
hotCreds Set MemberStatus
memberStatuses =
  ConwayEraOnwards era
-> QueryInShelleyBasedEra era CommitteeMembersState
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch CommitteeMembersState))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon (QueryInShelleyBasedEra era CommitteeMembersState
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch CommitteeMembersState)))
-> QueryInShelleyBasedEra era CommitteeMembersState
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch CommitteeMembersState))
forall a b. (a -> b) -> a -> b
$ Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> QueryInShelleyBasedEra era CommitteeMembersState
forall era.
Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> QueryInShelleyBasedEra era CommitteeMembersState
QueryCommitteeMembersState Set (Credential 'ColdCommitteeRole)
coldCreds Set (Credential 'HotCommitteeRole)
hotCreds Set MemberStatus
memberStatuses

queryStakeVoteDelegatees
  :: ConwayEraOnwards era
  -> Set StakeCredential
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       ( Either
           UnsupportedNtcVersionError
           (Either EraMismatch (Map StakeCredential L.DRep))
       )
queryStakeVoteDelegatees :: forall era block point r.
ConwayEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
queryStakeVoteDelegatees ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra era (Map StakeCredential DRep)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon (QueryInShelleyBasedEra era (Map StakeCredential DRep)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map StakeCredential DRep))))
-> (Set StakeCredential
    -> QueryInShelleyBasedEra era (Map StakeCredential DRep))
-> Set StakeCredential
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set StakeCredential
-> QueryInShelleyBasedEra era (Map StakeCredential DRep)
forall era.
Set StakeCredential
-> QueryInShelleyBasedEra era (Map StakeCredential DRep)
QueryStakeVoteDelegatees

queryAccountState
  :: ConwayEraOnwards era
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       (Either UnsupportedNtcVersionError (Either EraMismatch L.AccountState))
queryAccountState :: forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
queryAccountState ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra era AccountState
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon QueryInShelleyBasedEra era AccountState
forall era. QueryInShelleyBasedEra era AccountState
QueryAccountState

queryProposals
  :: forall era block point r
   . ConwayEraOnwards era
  -- Specify a set of Governance Action IDs to filter the proposals. When this set is
  -- empty, all the proposals considered for ratification will be returned.
  -> Set L.GovActionId
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       ( Either
           UnsupportedNtcVersionError
           (Either EraMismatch (Seq (L.GovActionState (ShelleyLedgerEra era))))
       )
queryProposals :: forall era block point r.
ConwayEraOnwards era
-> Set GovActionId
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
queryProposals ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra
     era (Seq (GovActionState (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon (QueryInShelleyBasedEra
   era (Seq (GovActionState (ShelleyLedgerEra era)))
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError
         (Either
            EraMismatch (Seq (GovActionState (ShelleyLedgerEra era))))))
-> (Set GovActionId
    -> QueryInShelleyBasedEra
         era (Seq (GovActionState (ShelleyLedgerEra era))))
-> Set GovActionId
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set GovActionId
-> QueryInShelleyBasedEra
     era (Seq (GovActionState (ShelleyLedgerEra era)))
forall era.
Set GovActionId
-> QueryInShelleyBasedEra
     era (Seq (GovActionState (ShelleyLedgerEra era)))
QueryProposals

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 :: forall era block point r.
ConwayEraOnwards era
-> KeyHash 'StakePool
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch DefaultVote))
queryStakePoolDefaultVote ConwayEraOnwards era
eon = ConwayEraOnwards era
-> QueryInShelleyBasedEra era DefaultVote
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch DefaultVote))
forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe ConwayEraOnwards era
eon (QueryInShelleyBasedEra era DefaultVote
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         UnsupportedNtcVersionError (Either EraMismatch DefaultVote)))
-> (KeyHash 'StakePool -> QueryInShelleyBasedEra era DefaultVote)
-> KeyHash 'StakePool
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch DefaultVote))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool -> QueryInShelleyBasedEra era DefaultVote
forall era.
KeyHash 'StakePool -> QueryInShelleyBasedEra era DefaultVote
QueryStakePoolDefaultVote

querySbe
  :: Convert eon ShelleyBasedEra
  => eon era
  -> QueryInShelleyBasedEra era result
  -> LocalStateQueryExpr
       block
       point
       QueryInMode
       r
       IO
       ( Either
           UnsupportedNtcVersionError
           (Either EraMismatch result)
       )
querySbe :: forall (eon :: * -> *) era result block point r.
Convert eon ShelleyBasedEra =>
eon era
-> QueryInShelleyBasedEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
querySbe eon era
eon QueryInShelleyBasedEra era result
queryInSbe =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either UnsupportedNtcVersionError (Either EraMismatch result)))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (eon era -> ShelleyBasedEra era
forall era. eon era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert eon era
eon) ((ShelleyBasedEraConstraints era =>
  LocalStateQueryExpr
    block
    point
    QueryInMode
    r
    IO
    (Either UnsupportedNtcVersionError (Either EraMismatch result)))
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either UnsupportedNtcVersionError (Either EraMismatch result)))
-> (ShelleyBasedEraConstraints era =>
    LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either UnsupportedNtcVersionError (Either EraMismatch result)))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
forall a b. (a -> b) -> a -> b
$
    QueryInMode (Either EraMismatch result)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr (QueryInMode (Either EraMismatch result)
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either UnsupportedNtcVersionError (Either EraMismatch result)))
-> (QueryInEra era result
    -> QueryInMode (Either EraMismatch result))
-> QueryInEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryInEra era result -> QueryInMode (Either EraMismatch result)
forall era result1.
QueryInEra era result1 -> QueryInMode (Either EraMismatch result1)
QueryInEra (QueryInEra era result
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either UnsupportedNtcVersionError (Either EraMismatch result)))
-> QueryInEra era result
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch result))
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra (eon era -> ShelleyBasedEra era
forall era. eon era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert eon era
eon) QueryInShelleyBasedEra era result
queryInSbe