{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Shelley.Ledger.Query
  ( BlockQuery (..)
  , NonMyopicMemberRewards (..)
  , StakeSnapshot (..)
  , StakeSnapshots (..)

    -- * Serialisation
  , decodeShelleyQuery
  , decodeShelleyResult
  , encodeShelleyQuery
  , encodeShelleyResult

    -- * BlockSupportsHFLedgerQuery instances
  , answerShelleyLookupQueries
  , answerShelleyTraversingQueries
  , shelleyQFTraverseTablesPredicate
  ) where

import Cardano.Binary
  ( FromCBOR (..)
  , ToCBOR (..)
  , encodeListLen
  , enforceSize
  )
import Cardano.Ledger.Address
import qualified Cardano.Ledger.Api.State.Query as SL
import Cardano.Ledger.CertState (lookupDepositDState)
import qualified Cardano.Ledger.CertState as SL
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Compactible (Compactible (fromCompact))
import qualified Cardano.Ledger.Conway.Governance as CG
import qualified Cardano.Ledger.Core as SL
import Cardano.Ledger.Credential (StakeCredential)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.Core as LC
import Cardano.Ledger.Shelley.LedgerState (AccountState)
import qualified Cardano.Ledger.Shelley.RewardProvenance as SL
  ( RewardProvenance
  )
import qualified Cardano.Ledger.State as SL
import Cardano.Ledger.UMap
  ( UMap (..)
  , rdReward
  , umElemDRep
  , umElemRDPair
  , umElemSPool
  )
import Cardano.Protocol.Crypto (Crypto)
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import Codec.Serialise (decode, encode)
import Control.DeepSeq (NFData)
import Data.Bifunctor (second)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MemPack
import Data.Sequence (Seq (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import qualified Data.VMap as VMap
import GHC.Generics (Generic)
import Lens.Micro
import Lens.Micro.Extras (view)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HardFork.Combinator.Basics
import Ouroboros.Consensus.HardFork.Combinator.Ledger.Query
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Basics
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Ledger.SupportsPeerSelection
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Protocol.Abstract (ChainDepState)
import qualified Ouroboros.Consensus.Shelley.Eras as SE
import Ouroboros.Consensus.Shelley.Ledger.Block
import Ouroboros.Consensus.Shelley.Ledger.Config
import Ouroboros.Consensus.Shelley.Ledger.Ledger
import Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion
  ( ShelleyNodeToClientVersion (..)
  )
import Ouroboros.Consensus.Shelley.Ledger.PeerSelection ()
import Ouroboros.Consensus.Shelley.Ledger.Query.Types
import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
import Ouroboros.Consensus.Storage.LedgerDB
import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
import Ouroboros.Consensus.Util (ShowProxy (..))
import Ouroboros.Consensus.Util.IndexedMemPack
import Ouroboros.Network.Block
  ( Serialised (..)
  , decodePoint
  , encodePoint
  , mkSerialised
  )
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
import Ouroboros.Network.PeerSelection.LedgerPeers.Utils

{-------------------------------------------------------------------------------
  BlockSupportsLedgerQuery
-------------------------------------------------------------------------------}

newtype NonMyopicMemberRewards = NonMyopicMemberRewards
  { NonMyopicMemberRewards
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
unNonMyopicMemberRewards ::
      Map
        (Either SL.Coin (SL.Credential 'SL.Staking))
        (Map (SL.KeyHash 'SL.StakePool) SL.Coin)
  }
  deriving stock Int -> NonMyopicMemberRewards -> ShowS
[NonMyopicMemberRewards] -> ShowS
NonMyopicMemberRewards -> String
(Int -> NonMyopicMemberRewards -> ShowS)
-> (NonMyopicMemberRewards -> String)
-> ([NonMyopicMemberRewards] -> ShowS)
-> Show NonMyopicMemberRewards
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonMyopicMemberRewards -> ShowS
showsPrec :: Int -> NonMyopicMemberRewards -> ShowS
$cshow :: NonMyopicMemberRewards -> String
show :: NonMyopicMemberRewards -> String
$cshowList :: [NonMyopicMemberRewards] -> ShowS
showList :: [NonMyopicMemberRewards] -> ShowS
Show
  deriving newtype (NonMyopicMemberRewards -> NonMyopicMemberRewards -> Bool
(NonMyopicMemberRewards -> NonMyopicMemberRewards -> Bool)
-> (NonMyopicMemberRewards -> NonMyopicMemberRewards -> Bool)
-> Eq NonMyopicMemberRewards
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonMyopicMemberRewards -> NonMyopicMemberRewards -> Bool
== :: NonMyopicMemberRewards -> NonMyopicMemberRewards -> Bool
$c/= :: NonMyopicMemberRewards -> NonMyopicMemberRewards -> Bool
/= :: NonMyopicMemberRewards -> NonMyopicMemberRewards -> Bool
Eq, Typeable NonMyopicMemberRewards
Typeable NonMyopicMemberRewards =>
(NonMyopicMemberRewards -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy NonMyopicMemberRewards -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [NonMyopicMemberRewards] -> Size)
-> ToCBOR NonMyopicMemberRewards
NonMyopicMemberRewards -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NonMyopicMemberRewards] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NonMyopicMemberRewards -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: NonMyopicMemberRewards -> Encoding
toCBOR :: NonMyopicMemberRewards -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NonMyopicMemberRewards -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy NonMyopicMemberRewards -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NonMyopicMemberRewards] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [NonMyopicMemberRewards] -> Size
ToCBOR, Typeable NonMyopicMemberRewards
Typeable NonMyopicMemberRewards =>
(forall s. Decoder s NonMyopicMemberRewards)
-> (Proxy NonMyopicMemberRewards -> Text)
-> FromCBOR NonMyopicMemberRewards
Proxy NonMyopicMemberRewards -> Text
forall s. Decoder s NonMyopicMemberRewards
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s NonMyopicMemberRewards
fromCBOR :: forall s. Decoder s NonMyopicMemberRewards
$clabel :: Proxy NonMyopicMemberRewards -> Text
label :: Proxy NonMyopicMemberRewards -> Text
FromCBOR)

type Delegations = Map (SL.Credential 'SL.Staking) (SL.KeyHash 'SL.StakePool)

type VoteDelegatees = Map (SL.Credential 'SL.Staking) SL.DRep

{-# DEPRECATED GetProposedPParamsUpdates "Deprecated in ShelleyNodeToClientVersion12" #-}

data instance BlockQuery (ShelleyBlock proto era) fp result where
  GetLedgerTip :: BlockQuery (ShelleyBlock proto era) QFNoTables (Point (ShelleyBlock proto era))
  GetEpochNo :: BlockQuery (ShelleyBlock proto era) QFNoTables EpochNo
  -- | Calculate the Non-Myopic Pool Member Rewards for a set of
  -- credentials. See 'SL.getNonMyopicMemberRewards'
  GetNonMyopicMemberRewards ::
    Set (Either SL.Coin (SL.Credential 'SL.Staking)) ->
    BlockQuery (ShelleyBlock proto era) QFNoTables NonMyopicMemberRewards
  GetCurrentPParams ::
    BlockQuery (ShelleyBlock proto era) QFNoTables (LC.PParams era)
  GetProposedPParamsUpdates ::
    BlockQuery (ShelleyBlock proto era) QFNoTables (SL.ProposedPPUpdates era)
  -- | This gets the stake distribution, but not in terms of _active_ stake
  -- (which we need for the leader schedule), but rather in terms of _total_
  -- stake, which is relevant for rewards. It is used by the wallet to show
  -- saturation levels to the end user. We should consider refactoring this, to
  -- an endpoint that provides all the information that the wallet wants about
  -- pools, in an extensible fashion.
  GetStakeDistribution ::
    BlockQuery (ShelleyBlock proto era) QFNoTables (PoolDistr (ProtoCrypto proto))
  -- | Get a subset of the UTxO, filtered by address. Although this will
  -- typically return a lot less data than 'GetUTxOWhole', it requires a linear
  -- search over the UTxO and so cost O(n) time.
  --
  -- Only 'GetUTxOByTxIn' is efficient in time and space.
  GetUTxOByAddress ::
    Set SL.Addr ->
    BlockQuery (ShelleyBlock proto era) QFTraverseTables (SL.UTxO era)
  -- | Get the /entire/ UTxO. This is only suitable for debug/testing purposes
  -- because otherwise it is far too much data.
  GetUTxOWhole ::
    BlockQuery (ShelleyBlock proto era) QFTraverseTables (SL.UTxO era)
  -- | Only for debugging purposes, we make no effort to ensure binary
  -- compatibility (cf the comment on 'GetCBOR'). Moreover, it is huge.
  DebugEpochState ::
    BlockQuery (ShelleyBlock proto era) QFNoTables (SL.EpochState era)
  -- | Wrap the result of the query using CBOR-in-CBOR.
  --
  -- For example, when a client is running a different version than the server
  -- and it sends a 'DebugEpochState' query, the client's decoder might fail to
  -- deserialise the epoch state as it might have changed between the two
  -- different versions. The client will then disconnect.
  --
  -- By using CBOR-in-CBOR, the client always successfully decodes the outer
  -- CBOR layer (so no disconnect) and can then manually try to decode the
  -- inner result. When the client's decoder is able to decode the inner
  -- result, it has access to the deserialised epoch state. When it fails to
  -- decode it, the client can fall back to pretty printing the actual CBOR,
  -- which is better than no output at all.
  GetCBOR ::
    BlockQuery (ShelleyBlock proto era) fp result ->
    BlockQuery (ShelleyBlock proto era) fp (Serialised result)
  GetFilteredDelegationsAndRewardAccounts ::
    Set (SL.Credential 'SL.Staking) ->
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      (Delegations, Map (SL.Credential 'Staking) Coin)
  GetGenesisConfig ::
    BlockQuery (ShelleyBlock proto era) QFNoTables CompactGenesis
  -- | Only for debugging purposes, we make no effort to ensure binary
  -- compatibility (cf the comment on 'GetCBOR'). Moreover, it is huge.
  DebugNewEpochState ::
    BlockQuery (ShelleyBlock proto era) QFNoTables (SL.NewEpochState era)
  -- | Only for debugging purposes, we make no effort to ensure binary
  -- compatibility (cf the comment on 'GetCBOR').
  DebugChainDepState ::
    BlockQuery (ShelleyBlock proto era) QFNoTables (ChainDepState proto)
  GetRewardProvenance ::
    BlockQuery (ShelleyBlock proto era) QFNoTables SL.RewardProvenance
  -- | Get a subset of the UTxO, filtered by transaction input. This is
  -- efficient and costs only O(m * log n) for m inputs and a UTxO of size n.
  GetUTxOByTxIn ::
    Set SL.TxIn ->
    BlockQuery (ShelleyBlock proto era) QFLookupTables (SL.UTxO era)
  GetStakePools ::
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      (Set (SL.KeyHash 'SL.StakePool))
  GetStakePoolParams ::
    Set (SL.KeyHash 'SL.StakePool) ->
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      (Map (SL.KeyHash 'SL.StakePool) SL.PoolParams)
  GetRewardInfoPools ::
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      ( SL.RewardParams
      , Map
          (SL.KeyHash 'SL.StakePool)
          (SL.RewardInfoPool)
      )
  GetPoolState ::
    Maybe (Set (SL.KeyHash 'SL.StakePool)) ->
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      (SL.PState era)
  GetStakeSnapshots ::
    Maybe (Set (SL.KeyHash 'SL.StakePool)) ->
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      StakeSnapshots
  GetPoolDistr ::
    Maybe (Set (SL.KeyHash 'SL.StakePool)) ->
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      (PoolDistr (ProtoCrypto proto))
  GetStakeDelegDeposits ::
    Set StakeCredential ->
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      (Map StakeCredential Coin)
  -- | Not supported in eras before Conway
  GetConstitution ::
    CG.ConwayEraGov era =>
    BlockQuery (ShelleyBlock proto era) QFNoTables (CG.Constitution era)
  -- | Although this query was introduced as part of Conway, it is general and
  --  so has non-degenerate semantics for eras before Conway.
  GetGovState ::
    BlockQuery (ShelleyBlock proto era) QFNoTables (LC.GovState era)
  -- | The argument specifies the credential of each 'DRep' whose state should
  -- be returned. When it's empty, the state of every 'DRep' is returned.
  --
  -- Not supported in eras before Conway.
  GetDRepState ::
    CG.ConwayEraGov era =>
    Set (SL.Credential 'DRepRole) ->
    BlockQuery
      (ShelleyBlock proto era)
      QFNoTables
      ( Map
          (SL.Credential 'DRepRole)
          SL.DRepState
      )
  -- | Query the 'DRep' stake distribution. Note that this can be an expensive
  -- query because there is a chance that the latest snapshot's distribution
  -- has not yet been fully computed.
  --
  -- The argument specifies whose stake should be returned. When it's empty,
  -- the stake of every 'DRep's is returned.
  --
  -- Not supported in eras before Conway.
  GetDRepStakeDistr ::
    CG.ConwayEraGov era =>
    Set SL.DRep ->
    BlockQuery (ShelleyBlock proto era) QFNoTables (Map SL.DRep Coin)
  -- | Query committee members
  --
  -- Not supported in eras before Conway.
  GetCommitteeMembersState ::
    CG.ConwayEraGov era =>
    Set (SL.Credential 'ColdCommitteeRole) ->
    Set (SL.Credential 'HotCommitteeRole) ->
    Set SL.MemberStatus ->
    BlockQuery (ShelleyBlock proto era) QFNoTables SL.CommitteeMembersState
  -- | Not supported in eras before Conway.
  GetFilteredVoteDelegatees ::
    CG.ConwayEraGov era =>
    Set (SL.Credential 'SL.Staking) ->
    BlockQuery (ShelleyBlock proto era) QFNoTables VoteDelegatees
  GetAccountState ::
    BlockQuery (ShelleyBlock proto era) QFNoTables AccountState
  -- | Query the SPO voting stake distribution.
  -- This stake distribution is different from the one used in leader election.
  --
  -- See: https://github.com/IntersectMBO/cardano-ledger/issues/4342
  --
  -- Not supported in eras before Conway.
  GetSPOStakeDistr ::
    CG.ConwayEraGov era =>
    Set (KeyHash 'StakePool) ->
    BlockQuery (ShelleyBlock proto era) QFNoTables (Map (KeyHash 'StakePool) Coin)
  GetProposals ::
    CG.ConwayEraGov era =>
    Set CG.GovActionId ->
    BlockQuery (ShelleyBlock proto era) QFNoTables (Seq (CG.GovActionState era))
  GetRatifyState ::
    CG.ConwayEraGov era =>
    BlockQuery (ShelleyBlock proto era) QFNoTables (CG.RatifyState era)
  GetFuturePParams ::
    BlockQuery (ShelleyBlock proto era) QFNoTables (Maybe (LC.PParams era))
  -- | Obtain a snapshot of big ledger peers. CLI can serialize these,
  -- and if made available to the node by topology configuration,
  -- the diffusion layer can use these peers when syncing up from scratch
  -- or stale ledger state - especially useful for Genesis mode
  GetBigLedgerPeerSnapshot ::
    BlockQuery (ShelleyBlock proto era) QFNoTables LedgerPeerSnapshot
  QueryStakePoolDefaultVote ::
    CG.ConwayEraGov era =>
    KeyHash 'StakePool ->
    BlockQuery (ShelleyBlock proto era) QFNoTables CG.DefaultVote

-- WARNING: please add new queries to the end of the list and stick to this
-- order in all other pattern matches on queries. This helps in particular
-- with the en/decoders, as we want the CBOR tags to be ordered.
--
-- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@ must
-- be added. See #2830 for a template on how to do this.
--
-- WARNING: never modify an existing query that has been incorporated in a
-- release of the node, as it will break compatibility with deployed nodes.
-- Instead, add a new query. To remove the old query, first to stop supporting
-- it by modifying 'querySupportedVersion' (@< X@) and when the version is no
-- longer used (because mainnet has hard-forked to a newer version), it can be
-- removed.

instance
  (Typeable era, Typeable proto) =>
  ShowProxy (BlockQuery (ShelleyBlock proto era))

instance
  ( ShelleyCompatible proto era
  , LedgerSupportsProtocol (ShelleyBlock proto era)
  , ProtoCrypto proto ~ crypto
  , Crypto crypto
  ) =>
  BlockSupportsLedgerQuery (ShelleyBlock proto era)
  where
  answerPureBlockQuery :: forall result.
ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables result
-> ExtLedgerState (ShelleyBlock proto era) EmptyMK
-> result
answerPureBlockQuery ExtLedgerCfg (ShelleyBlock proto era)
cfg BlockQuery (ShelleyBlock proto era) 'QFNoTables result
query ExtLedgerState (ShelleyBlock proto era) EmptyMK
ext =
    case BlockQuery (ShelleyBlock proto era) 'QFNoTables result
query of
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetLedgerTip ->
        LedgerState (ShelleyBlock proto era) EmptyMK
-> Point (ShelleyBlock proto era)
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
shelleyLedgerTipPoint LedgerState (ShelleyBlock proto era) EmptyMK
lst
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetEpochNo ->
        NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
SL.nesEL NewEpochState era
st
      GetNonMyopicMemberRewards Set (Either Coin (Credential 'Staking))
creds ->
        Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
-> NonMyopicMemberRewards
NonMyopicMemberRewards (Map
   (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
 -> NonMyopicMemberRewards)
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
-> NonMyopicMemberRewards
forall a b. (a -> b) -> a -> b
$
          Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking))
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
forall era.
(EraGov era, EraStake era, EraCertState era) =>
Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking))
-> Map
     (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
SL.getNonMyopicMemberRewards Globals
globals NewEpochState era
st Set (Either Coin (Credential 'Staking))
creds
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetCurrentPParams ->
        NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams NewEpochState era
st
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetProposedPParamsUpdates ->
        Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
SL.ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate era)
forall k a. Map k a
Map.empty
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetStakeDistribution ->
        PoolDistr -> PoolDistr crypto
forall c. PoolDistr -> PoolDistr c
fromLedgerPoolDistr (PoolDistr -> PoolDistr crypto) -> PoolDistr -> PoolDistr crypto
forall a b. (a -> b) -> a -> b
$ Globals -> NewEpochState era -> PoolDistr
forall era.
(EraGov era, EraStake era, EraCertState era) =>
Globals -> NewEpochState era -> PoolDistr
SL.poolsByTotalStakeFraction Globals
globals NewEpochState era
st
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
DebugEpochState ->
        NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
getEpochState NewEpochState era
st
      GetCBOR BlockQuery (ShelleyBlock proto era) 'QFNoTables result
query' ->
        -- We encode using the latest (@maxBound@) ShelleyNodeToClientVersion,
        -- as the @GetCBOR@ query already is about opportunistically assuming
        -- both client and server are running the same version; cf. the
        -- @GetCBOR@ Haddocks.
        (result -> Encoding) -> result -> Serialised result
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables result
-> result
-> Encoding
forall proto era (fp :: QueryFootprint) result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) fp result
-> result
-> Encoding
encodeShelleyResult ShelleyNodeToClientVersion
forall a. Bounded a => a
maxBound BlockQuery (ShelleyBlock proto era) 'QFNoTables result
query') (result -> Serialised result) -> result -> Serialised result
forall a b. (a -> b) -> a -> b
$
          ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables result
-> ExtLedgerState (ShelleyBlock proto era) EmptyMK
-> result
forall result.
ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables result
-> ExtLedgerState (ShelleyBlock proto era) EmptyMK
-> result
forall blk result.
BlockSupportsLedgerQuery blk =>
ExtLedgerCfg blk
-> BlockQuery blk 'QFNoTables result
-> ExtLedgerState blk EmptyMK
-> result
answerPureBlockQuery ExtLedgerCfg (ShelleyBlock proto era)
cfg BlockQuery (ShelleyBlock proto era) 'QFNoTables result
query' ExtLedgerState (ShelleyBlock proto era) EmptyMK
ext
      GetFilteredDelegationsAndRewardAccounts Set (Credential 'Staking)
creds ->
        NewEpochState era
-> Set (Credential 'Staking)
-> (Delegations, Map (Credential 'Staking) Coin)
forall era.
EraCertState era =>
NewEpochState era
-> Set (Credential 'Staking)
-> (Delegations, Map (Credential 'Staking) Coin)
getFilteredDelegationsAndRewardAccounts NewEpochState era
st Set (Credential 'Staking)
creds
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetGenesisConfig ->
        ShelleyLedgerConfig era -> CompactGenesis
forall era. ShelleyLedgerConfig era -> CompactGenesis
shelleyLedgerCompactGenesis LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
lcfg
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
DebugNewEpochState ->
        result
NewEpochState era
st
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
DebugChainDepState ->
        HeaderState (ShelleyBlock proto era)
-> ChainDepState (BlockProtocol (ShelleyBlock proto era))
forall blk. HeaderState blk -> ChainDepState (BlockProtocol blk)
headerStateChainDep HeaderState (ShelleyBlock proto era)
hst
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetRewardProvenance ->
        (RewardUpdate, RewardProvenance) -> RewardProvenance
forall a b. (a, b) -> b
snd ((RewardUpdate, RewardProvenance) -> RewardProvenance)
-> (RewardUpdate, RewardProvenance) -> RewardProvenance
forall a b. (a -> b) -> a -> b
$ Globals -> NewEpochState era -> (RewardUpdate, RewardProvenance)
forall era.
(EraGov era, EraCertState era) =>
Globals -> NewEpochState era -> (RewardUpdate, RewardProvenance)
SL.getRewardProvenance Globals
globals NewEpochState era
st
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetStakePools ->
        NewEpochState era -> Set (KeyHash 'StakePool)
forall era.
EraCertState era =>
NewEpochState era -> Set (KeyHash 'StakePool)
SL.getPools NewEpochState era
st
      GetStakePoolParams Set (KeyHash 'StakePool)
poolids ->
        NewEpochState era
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) PoolParams
forall era.
EraCertState era =>
NewEpochState era
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) PoolParams
SL.getPoolParameters NewEpochState era
st Set (KeyHash 'StakePool)
poolids
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetRewardInfoPools ->
        Globals
-> NewEpochState era
-> (RewardParams, Map (KeyHash 'StakePool) RewardInfoPool)
forall era.
(EraGov era, EraStake era, EraCertState era) =>
Globals
-> NewEpochState era
-> (RewardParams, Map (KeyHash 'StakePool) RewardInfoPool)
SL.getRewardInfoPools Globals
globals NewEpochState era
st
      GetPoolState Maybe (Set (KeyHash 'StakePool))
mPoolIds ->
        let certPState :: PState era
certPState = Getting (PState era) (CertState era) (PState era)
-> CertState era -> PState era
forall a s. Getting a s a -> s -> a
view Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
SL.certPStateL (CertState era -> PState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> PState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
SL.lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
SL.esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
SL.nesEs (NewEpochState era -> PState era)
-> NewEpochState era -> PState era
forall a b. (a -> b) -> a -> b
$ NewEpochState era
st
         in case Maybe (Set (KeyHash 'StakePool))
mPoolIds of
              Just Set (KeyHash 'StakePool)
poolIds ->
                SL.PState
                  { psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
SL.psStakePoolParams =
                      Map (KeyHash 'StakePool) PoolParams
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) PoolParams
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
SL.psStakePoolParams PState era
certPState) Set (KeyHash 'StakePool)
poolIds
                  , psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
SL.psFutureStakePoolParams =
                      Map (KeyHash 'StakePool) PoolParams
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) PoolParams
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
SL.psFutureStakePoolParams PState era
certPState) Set (KeyHash 'StakePool)
poolIds
                  , psRetiring :: Map (KeyHash 'StakePool) EpochNo
SL.psRetiring = Map (KeyHash 'StakePool) EpochNo
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) EpochNo
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (PState era -> Map (KeyHash 'StakePool) EpochNo
forall era. PState era -> Map (KeyHash 'StakePool) EpochNo
SL.psRetiring PState era
certPState) Set (KeyHash 'StakePool)
poolIds
                  , psDeposits :: Map (KeyHash 'StakePool) Coin
SL.psDeposits = Map (KeyHash 'StakePool) Coin
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) Coin
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (PState era -> Map (KeyHash 'StakePool) Coin
forall era. PState era -> Map (KeyHash 'StakePool) Coin
SL.psDeposits PState era
certPState) Set (KeyHash 'StakePool)
poolIds
                  }
              Maybe (Set (KeyHash 'StakePool))
Nothing -> result
PState era
certPState
      GetStakeSnapshots Maybe (Set (KeyHash 'StakePool))
mPoolIds ->
        let SL.SnapShots
              { SnapShot
ssStakeMark :: SnapShot
ssStakeMark :: SnapShots -> SnapShot
SL.ssStakeMark
              , SnapShot
ssStakeSet :: SnapShot
ssStakeSet :: SnapShots -> SnapShot
SL.ssStakeSet
              , SnapShot
ssStakeGo :: SnapShot
ssStakeGo :: SnapShots -> SnapShot
SL.ssStakeGo
              } = EpochState era -> SnapShots
forall era. EpochState era -> SnapShots
SL.esSnapshots (EpochState era -> SnapShots)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> SnapShots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
SL.nesEs (NewEpochState era -> SnapShots) -> NewEpochState era -> SnapShots
forall a b. (a -> b) -> a -> b
$ NewEpochState era
st

            totalMarkByPoolId :: Map (KeyHash 'StakePool) Coin
            totalMarkByPoolId :: Map (KeyHash 'StakePool) Coin
totalMarkByPoolId = VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Stake -> Map (KeyHash 'StakePool) Coin
SL.sumStakePerPool (SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
SL.ssDelegations SnapShot
ssStakeMark) (SnapShot -> Stake
SL.ssStake SnapShot
ssStakeMark)

            totalSetByPoolId :: Map (KeyHash 'StakePool) Coin
            totalSetByPoolId :: Map (KeyHash 'StakePool) Coin
totalSetByPoolId = VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Stake -> Map (KeyHash 'StakePool) Coin
SL.sumStakePerPool (SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
SL.ssDelegations SnapShot
ssStakeSet) (SnapShot -> Stake
SL.ssStake SnapShot
ssStakeSet)

            totalGoByPoolId :: Map (KeyHash 'StakePool) Coin
            totalGoByPoolId :: Map (KeyHash 'StakePool) Coin
totalGoByPoolId = VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> Stake -> Map (KeyHash 'StakePool) Coin
SL.sumStakePerPool (SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
SL.ssDelegations SnapShot
ssStakeGo) (SnapShot -> Stake
SL.ssStake SnapShot
ssStakeGo)

            getPoolStakes :: Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) StakeSnapshot
            getPoolStakes :: Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) StakeSnapshot
getPoolStakes Set (KeyHash 'StakePool)
poolIds = (KeyHash 'StakePool -> StakeSnapshot)
-> Set (KeyHash 'StakePool)
-> Map (KeyHash 'StakePool) StakeSnapshot
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet KeyHash 'StakePool -> StakeSnapshot
mkStakeSnapshot Set (KeyHash 'StakePool)
poolIds
             where
              mkStakeSnapshot :: KeyHash 'StakePool -> StakeSnapshot
mkStakeSnapshot KeyHash 'StakePool
poolId =
                StakeSnapshot
                  { ssMarkPool :: Coin
ssMarkPool = Coin -> KeyHash 'StakePool -> Map (KeyHash 'StakePool) Coin -> Coin
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Coin
forall a. Monoid a => a
mempty KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) Coin
totalMarkByPoolId
                  , ssSetPool :: Coin
ssSetPool = Coin -> KeyHash 'StakePool -> Map (KeyHash 'StakePool) Coin -> Coin
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Coin
forall a. Monoid a => a
mempty KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) Coin
totalSetByPoolId
                  , ssGoPool :: Coin
ssGoPool = Coin -> KeyHash 'StakePool -> Map (KeyHash 'StakePool) Coin -> Coin
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Coin
forall a. Monoid a => a
mempty KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) Coin
totalGoByPoolId
                  }

            getAllStake :: SL.SnapShot -> SL.Coin
            getAllStake :: SnapShot -> Coin
getAllStake (SL.SnapShot Stake
stake VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
_ VMap VB VB (KeyHash 'StakePool) PoolParams
_) = (CompactForm Coin -> Coin)
-> VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Coin
forall (vv :: * -> *) v m (kv :: * -> *) k.
(Vector vv v, Monoid m) =>
(v -> m) -> VMap kv vv k v -> m
VMap.foldMap CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (Stake -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
SL.unStake Stake
stake)
         in case Maybe (Set (KeyHash 'StakePool))
mPoolIds of
              Maybe (Set (KeyHash 'StakePool))
Nothing ->
                let poolIds :: Set (KeyHash 'StakePool)
poolIds =
                      [KeyHash 'StakePool] -> Set (KeyHash 'StakePool)
forall a. Ord a => [a] -> Set a
Set.fromList ([KeyHash 'StakePool] -> Set (KeyHash 'StakePool))
-> [KeyHash 'StakePool] -> Set (KeyHash 'StakePool)
forall a b. (a -> b) -> a -> b
$
                        [[KeyHash 'StakePool]] -> [KeyHash 'StakePool]
forall a. Monoid a => [a] -> a
mconcat
                          [ VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> [KeyHash 'StakePool]
forall (vv :: * -> *) v (kv :: * -> *) k.
Vector vv v =>
VMap kv vv k v -> [v]
VMap.elems (SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
SL.ssDelegations SnapShot
ssStakeMark)
                          , VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> [KeyHash 'StakePool]
forall (vv :: * -> *) v (kv :: * -> *) k.
Vector vv v =>
VMap kv vv k v -> [v]
VMap.elems (SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
SL.ssDelegations SnapShot
ssStakeSet)
                          , VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
-> [KeyHash 'StakePool]
forall (vv :: * -> *) v (kv :: * -> *) k.
Vector vv v =>
VMap kv vv k v -> [v]
VMap.elems (SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
SL.ssDelegations SnapShot
ssStakeGo)
                          ]
                 in StakeSnapshots
                      { ssStakeSnapshots :: Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots = Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) StakeSnapshot
getPoolStakes Set (KeyHash 'StakePool)
poolIds
                      , ssMarkTotal :: Coin
ssMarkTotal = SnapShot -> Coin
getAllStake SnapShot
ssStakeMark
                      , ssSetTotal :: Coin
ssSetTotal = SnapShot -> Coin
getAllStake SnapShot
ssStakeSet
                      , ssGoTotal :: Coin
ssGoTotal = SnapShot -> Coin
getAllStake SnapShot
ssStakeGo
                      }
              Just Set (KeyHash 'StakePool)
poolIds ->
                StakeSnapshots
                  { ssStakeSnapshots :: Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots = Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) StakeSnapshot
getPoolStakes Set (KeyHash 'StakePool)
poolIds
                  , ssMarkTotal :: Coin
ssMarkTotal = SnapShot -> Coin
getAllStake SnapShot
ssStakeMark
                  , ssSetTotal :: Coin
ssSetTotal = SnapShot -> Coin
getAllStake SnapShot
ssStakeSet
                  , ssGoTotal :: Coin
ssGoTotal = SnapShot -> Coin
getAllStake SnapShot
ssStakeGo
                  }
      GetPoolDistr Maybe (Set (KeyHash 'StakePool))
mPoolIds ->
        let stakeSet :: SnapShot
stakeSet = SnapShots -> SnapShot
SL.ssStakeSet (SnapShots -> SnapShot)
-> (EpochState era -> SnapShots) -> EpochState era -> SnapShot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> SnapShots
forall era. EpochState era -> SnapShots
SL.esSnapshots (EpochState era -> SnapShot) -> EpochState era -> SnapShot
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
getEpochState NewEpochState era
st
         in PoolDistr -> PoolDistr crypto
forall c. PoolDistr -> PoolDistr c
fromLedgerPoolDistr (PoolDistr -> PoolDistr crypto) -> PoolDistr -> PoolDistr crypto
forall a b. (a -> b) -> a -> b
$
              (KeyHash 'StakePool -> Bool) -> SnapShot -> PoolDistr
SL.calculatePoolDistr' ((KeyHash 'StakePool -> Bool)
-> (Set (KeyHash 'StakePool) -> KeyHash 'StakePool -> Bool)
-> Maybe (Set (KeyHash 'StakePool))
-> KeyHash 'StakePool
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> KeyHash 'StakePool -> Bool
forall a b. a -> b -> a
const Bool
True) ((KeyHash 'StakePool -> Set (KeyHash 'StakePool) -> Bool)
-> Set (KeyHash 'StakePool) -> KeyHash 'StakePool -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip KeyHash 'StakePool -> Set (KeyHash 'StakePool) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member) Maybe (Set (KeyHash 'StakePool))
mPoolIds) SnapShot
stakeSet
      GetStakeDelegDeposits Set (Credential 'Staking)
stakeCreds ->
        let lookupDeposit :: Credential 'Staking -> Maybe Coin
lookupDeposit =
              DState era -> Credential 'Staking -> Maybe Coin
forall era. DState era -> Credential 'Staking -> Maybe Coin
lookupDepositDState (Getting (DState era) (CertState era) (DState era)
-> CertState era -> DState era
forall a s. Getting a s a -> s -> a
view Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
SL.certDStateL (CertState era -> DState era) -> CertState era -> DState era
forall a b. (a -> b) -> a -> b
$ LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
SL.lsCertState (LedgerState era -> CertState era)
-> LedgerState era -> CertState era
forall a b. (a -> b) -> a -> b
$ EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
SL.esLState (EpochState era -> LedgerState era)
-> EpochState era -> LedgerState era
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
SL.nesEs NewEpochState era
st)
            lookupInsert :: Map (Credential 'Staking) Coin
-> Credential 'Staking -> Map (Credential 'Staking) Coin
lookupInsert Map (Credential 'Staking) Coin
acc Credential 'Staking
cred =
              case Credential 'Staking -> Maybe Coin
lookupDeposit Credential 'Staking
cred of
                Maybe Coin
Nothing -> Map (Credential 'Staking) Coin
acc
                Just Coin
deposit -> Credential 'Staking
-> Coin
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking
cred Coin
deposit Map (Credential 'Staking) Coin
acc
         in (result -> Credential 'Staking -> result)
-> result -> Set (Credential 'Staking) -> result
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' result -> Credential 'Staking -> result
Map (Credential 'Staking) Coin
-> Credential 'Staking -> Map (Credential 'Staking) Coin
lookupInsert result
Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty Set (Credential 'Staking)
stakeCreds
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetConstitution ->
        NewEpochState era -> Constitution era
forall era.
ConwayEraGov era =>
NewEpochState era -> Constitution era
SL.queryConstitution NewEpochState era
st
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetGovState ->
        NewEpochState era -> GovState era
forall era. NewEpochState era -> GovState era
SL.queryGovState NewEpochState era
st
      GetDRepState Set (Credential 'DRepRole)
drepCreds ->
        NewEpochState era
-> Set (Credential 'DRepRole)
-> Map (Credential 'DRepRole) DRepState
forall era.
EraCertState era =>
NewEpochState era
-> Set (Credential 'DRepRole)
-> Map (Credential 'DRepRole) DRepState
SL.queryDRepState NewEpochState era
st Set (Credential 'DRepRole)
drepCreds
      GetDRepStakeDistr Set DRep
dreps ->
        NewEpochState era -> Set DRep -> Map DRep Coin
forall era.
ConwayEraGov era =>
NewEpochState era -> Set DRep -> Map DRep Coin
SL.queryDRepStakeDistr NewEpochState era
st Set DRep
dreps
      GetCommitteeMembersState Set (Credential 'ColdCommitteeRole)
coldCreds Set (Credential 'HotCommitteeRole)
hotCreds Set MemberStatus
statuses ->
        Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> CommitteeMembersState
forall era.
(ConwayEraGov era, EraCertState era) =>
Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> CommitteeMembersState
SL.queryCommitteeMembersState Set (Credential 'ColdCommitteeRole)
coldCreds Set (Credential 'HotCommitteeRole)
hotCreds Set MemberStatus
statuses NewEpochState era
st
      GetFilteredVoteDelegatees Set (Credential 'Staking)
stakeCreds ->
        NewEpochState era
-> Set (Credential 'Staking) -> Map (Credential 'Staking) DRep
forall era.
EraCertState era =>
NewEpochState era
-> Set (Credential 'Staking) -> Map (Credential 'Staking) DRep
getFilteredVoteDelegatees NewEpochState era
st Set (Credential 'Staking)
stakeCreds
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetAccountState ->
        NewEpochState era -> AccountState
forall era. NewEpochState era -> AccountState
SL.queryAccountState NewEpochState era
st
      GetSPOStakeDistr Set (KeyHash 'StakePool)
keys ->
        NewEpochState era
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) Coin
forall era.
ConwayEraGov era =>
NewEpochState era
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) Coin
SL.querySPOStakeDistr NewEpochState era
st Set (KeyHash 'StakePool)
keys
      GetProposals Set GovActionId
gids ->
        NewEpochState era -> Set GovActionId -> Seq (GovActionState era)
forall era.
ConwayEraGov era =>
NewEpochState era -> Set GovActionId -> Seq (GovActionState era)
SL.queryProposals NewEpochState era
st Set GovActionId
gids
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetRatifyState ->
        NewEpochState era -> RatifyState era
forall era.
ConwayEraGov era =>
NewEpochState era -> RatifyState era
SL.queryRatifyState NewEpochState era
st
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetFuturePParams ->
        NewEpochState era -> Maybe (PParams era)
forall era. EraGov era => NewEpochState era -> Maybe (PParams era)
SL.queryFuturePParams NewEpochState era
st
      BlockQuery (ShelleyBlock proto era) 'QFNoTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFNoTables result
GetBigLedgerPeerSnapshot ->
        let slot :: WithOrigin SlotNo
slot = LedgerState (ShelleyBlock proto era) EmptyMK -> WithOrigin SlotNo
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
GetTip l =>
l mk -> WithOrigin SlotNo
getTipSlot LedgerState (ShelleyBlock proto era) EmptyMK
lst
            ledgerPeers :: [(PoolStake, NonEmpty RelayAccessPoint)]
ledgerPeers = (NonEmpty StakePoolRelay -> NonEmpty RelayAccessPoint)
-> (PoolStake, NonEmpty StakePoolRelay)
-> (PoolStake, NonEmpty RelayAccessPoint)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((StakePoolRelay -> RelayAccessPoint)
-> NonEmpty StakePoolRelay -> NonEmpty RelayAccessPoint
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StakePoolRelay -> RelayAccessPoint
stakePoolRelayAccessPoint) ((PoolStake, NonEmpty StakePoolRelay)
 -> (PoolStake, NonEmpty RelayAccessPoint))
-> [(PoolStake, NonEmpty StakePoolRelay)]
-> [(PoolStake, NonEmpty RelayAccessPoint)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerState (ShelleyBlock proto era) EmptyMK
-> [(PoolStake, NonEmpty StakePoolRelay)]
forall blk (mk :: * -> * -> *).
LedgerSupportsPeerSelection blk =>
LedgerState blk mk -> [(PoolStake, NonEmpty StakePoolRelay)]
forall (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers LedgerState (ShelleyBlock proto era) EmptyMK
lst
            bigLedgerPeers :: [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
bigLedgerPeers = [(PoolStake, NonEmpty RelayAccessPoint)]
-> [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
accumulateBigLedgerStake [(PoolStake, NonEmpty RelayAccessPoint)]
ledgerPeers
         in (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-> LedgerPeerSnapshot
LedgerPeerSnapshot (WithOrigin SlotNo
slot, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
bigLedgerPeers)
      QueryStakePoolDefaultVote KeyHash 'StakePool
stakePool ->
        NewEpochState era -> KeyHash 'StakePool -> DefaultVote
forall era.
EraCertState era =>
NewEpochState era -> KeyHash 'StakePool -> DefaultVote
SL.queryStakePoolDefaultVote NewEpochState era
st KeyHash 'StakePool
stakePool
   where
    lcfg :: LedgerConfig (ShelleyBlock proto era)
lcfg = TopLevelConfig (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger (TopLevelConfig (ShelleyBlock proto era)
 -> LedgerConfig (ShelleyBlock proto era))
-> TopLevelConfig (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg (ShelleyBlock proto era)
-> TopLevelConfig (ShelleyBlock proto era)
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg ExtLedgerCfg (ShelleyBlock proto era)
cfg
    globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
lcfg
    -- NOTE: we are not pattern matching on @ext@ but using the accessors
    -- here. The reason for that is that that pattern match blows up the
    -- compile time (in particular the time spent desugaring, which is when
    -- the compiler looks at pattern matches) to 2m30s! We don't really
    -- understand why, but our guess is that it has to do with the combination
    -- of the strictness of 'ExtLedgerState', the fact that @LedgerState@ is a
    -- data family, and the 'ShelleyBasedEra' constraint.
    lst :: LedgerState (ShelleyBlock proto era) EmptyMK
lst = ExtLedgerState (ShelleyBlock proto era) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK
forall blk (mk :: * -> * -> *).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState ExtLedgerState (ShelleyBlock proto era) EmptyMK
ext
    hst :: HeaderState (ShelleyBlock proto era)
hst = ExtLedgerState (ShelleyBlock proto era) EmptyMK
-> HeaderState (ShelleyBlock proto era)
forall blk (mk :: * -> * -> *).
ExtLedgerState blk mk -> HeaderState blk
headerState ExtLedgerState (ShelleyBlock proto era) EmptyMK
ext
    st :: NewEpochState era
st = LedgerState (ShelleyBlock proto era) EmptyMK -> NewEpochState era
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState LedgerState (ShelleyBlock proto era) EmptyMK
lst

  answerBlockQueryLookup :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> ReadOnlyForker' m (ShelleyBlock proto era)
-> m result
answerBlockQueryLookup = (LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
 -> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK)
-> (TxOut (LedgerState (ShelleyBlock proto era)) -> TxOut era)
-> (TxIn (LedgerState (ShelleyBlock proto era)) -> TxIn)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> ReadOnlyForker' m (ShelleyBlock proto era)
-> m result
forall proto era (m :: * -> *) result blk.
(Monad m, ShelleyCompatible proto era) =>
(LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
 -> LedgerTables (LedgerState blk) KeysMK)
-> (TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> ReadOnlyForker' m blk
-> m result
answerShelleyLookupQueries LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
forall a. a -> a
id TxOut era -> TxOut era
TxOut (LedgerState (ShelleyBlock proto era)) -> TxOut era
forall a. a -> a
id TxIn -> TxIn
TxIn (LedgerState (ShelleyBlock proto era)) -> TxIn
forall a. a -> a
id

  answerBlockQueryTraverse :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> ReadOnlyForker' m (ShelleyBlock proto era)
-> m result
answerBlockQueryTraverse = (TxOut (LedgerState (ShelleyBlock proto era)) -> TxOut era)
-> (TxIn (LedgerState (ShelleyBlock proto era)) -> TxIn)
-> (forall result'.
    BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
    -> TxOut (LedgerState (ShelleyBlock proto era)) -> Bool)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> ReadOnlyForker' m (ShelleyBlock proto era)
-> m result
forall proto era (m :: * -> *) result blk.
(ShelleyCompatible proto era, Ord (TxIn (LedgerState blk)),
 Eq (TxOut (LedgerState blk)), MemPack (TxIn (LedgerState blk)),
 IndexedMemPack (LedgerState blk EmptyMK) (TxOut (LedgerState blk)),
 Monad m) =>
(TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> (forall result'.
    BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
    -> TxOut (LedgerState blk) -> Bool)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> ReadOnlyForker' m blk
-> m result
answerShelleyTraversingQueries TxOut era -> TxOut era
TxOut (LedgerState (ShelleyBlock proto era)) -> TxOut era
forall a. a -> a
id TxIn -> TxIn
TxIn (LedgerState (ShelleyBlock proto era)) -> TxIn
forall a. a -> a
id BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
-> TxOut (LedgerState (ShelleyBlock proto era)) -> Bool
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
-> TxOut (LedgerState (ShelleyBlock Any era)) -> Bool
forall result'.
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
-> TxOut (LedgerState (ShelleyBlock proto era)) -> Bool
forall proto era proto' era' result.
(ShelleyBasedEra era, ShelleyBasedEra era') =>
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> TxOut (LedgerState (ShelleyBlock proto' era')) -> Bool
shelleyQFTraverseTablesPredicate

  -- \| Is the given query supported by the given 'ShelleyNodeToClientVersion'?
  blockQueryIsSupportedOnVersion :: forall (fp :: QueryFootprint) result.
BlockQuery (ShelleyBlock proto era) fp result
-> BlockNodeToClientVersion (ShelleyBlock proto era) -> Bool
blockQueryIsSupportedOnVersion = \case
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetLedgerTip -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetEpochNo -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetNonMyopicMemberRewards{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetCurrentPParams -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetProposedPParamsUpdates -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
< ShelleyNodeToClientVersion
v12)
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakeDistribution -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetUTxOByAddress{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetUTxOWhole -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugEpochState -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetCBOR BlockQuery (ShelleyBlock proto era) fp result
q -> BlockQuery (ShelleyBlock proto era) fp result
-> BlockNodeToClientVersion (ShelleyBlock proto era) -> Bool
forall blk (fp :: QueryFootprint) result.
BlockSupportsLedgerQuery blk =>
BlockQuery blk fp result -> BlockNodeToClientVersion blk -> Bool
forall (fp :: QueryFootprint) result.
BlockQuery (ShelleyBlock proto era) fp result
-> BlockNodeToClientVersion (ShelleyBlock proto era) -> Bool
blockQueryIsSupportedOnVersion BlockQuery (ShelleyBlock proto era) fp result
q
    GetFilteredDelegationsAndRewardAccounts{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGenesisConfig -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugNewEpochState -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugChainDepState -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardProvenance -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetUTxOByTxIn{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakePools -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetStakePoolParams{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardInfoPools -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetPoolState{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetStakeSnapshots{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetPoolDistr{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    GetStakeDelegDeposits{} -> Bool -> ShelleyNodeToClientVersion -> Bool
forall a b. a -> b -> a
const Bool
True
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetConstitution -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v8)
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGovState -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v8)
    GetDRepState{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v8)
    GetDRepStakeDistr{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v8)
    GetCommitteeMembersState{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v8)
    GetFilteredVoteDelegatees{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v8)
    GetAccountState{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v8)
    GetSPOStakeDistr{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v8)
    GetProposals{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v9)
    GetRatifyState{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v9)
    GetFuturePParams{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v10)
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetBigLedgerPeerSnapshot -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v11)
    QueryStakePoolDefaultVote{} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v12)
   where
    -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@
    -- must be added. See #2830 for a template on how to do this.

    v8 :: ShelleyNodeToClientVersion
v8 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion8
    v9 :: ShelleyNodeToClientVersion
v9 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion9
    v10 :: ShelleyNodeToClientVersion
v10 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion10
    v11 :: ShelleyNodeToClientVersion
v11 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion11
    v12 :: ShelleyNodeToClientVersion
v12 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion12

instance SameDepIndex2 (BlockQuery (ShelleyBlock proto era)) where
  sameDepIndex2 :: forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery (ShelleyBlock proto era) x a
-> BlockQuery (ShelleyBlock proto era) y b
-> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetLedgerTip BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetLedgerTip =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetLedgerTip BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetEpochNo BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetEpochNo =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetEpochNo BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetNonMyopicMemberRewards Set (Either Coin (Credential 'Staking))
creds) (GetNonMyopicMemberRewards Set (Either Coin (Credential 'Staking))
creds')
    | Set (Either Coin (Credential 'Staking))
creds Set (Either Coin (Credential 'Staking))
-> Set (Either Coin (Credential 'Staking)) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Either Coin (Credential 'Staking))
creds' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetNonMyopicMemberRewards Set (Either Coin (Credential 'Staking))
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetCurrentPParams BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetCurrentPParams =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetCurrentPParams BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetProposedPParamsUpdates BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetProposedPParamsUpdates =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetProposedPParamsUpdates BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetStakeDistribution BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetStakeDistribution =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetStakeDistribution BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetUTxOByAddress Set Addr
addrs) (GetUTxOByAddress Set Addr
addrs')
    | Set Addr
addrs Set Addr -> Set Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Set Addr
addrs' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetUTxOByAddress Set Addr
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetUTxOWhole BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetUTxOWhole =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetUTxOWhole BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
DebugEpochState BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
DebugEpochState =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
DebugEpochState BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetCBOR BlockQuery (ShelleyBlock proto era) x result
q) (GetCBOR BlockQuery (ShelleyBlock proto era) y result
q') =
    (\'(x, result) :~: '(y, result)
Refl -> '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl) (('(x, result) :~: '(y, result)) -> '(x, a) :~: '(y, b))
-> Maybe ('(x, result) :~: '(y, result))
-> Maybe ('(x, a) :~: '(y, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockQuery (ShelleyBlock proto era) x result
-> BlockQuery (ShelleyBlock proto era) y result
-> Maybe ('(x, result) :~: '(y, result))
forall k1 k2 (f :: k1 -> k2 -> *) (x :: k1) (a :: k2) (y :: k1)
       (b :: k2).
SameDepIndex2 f =>
f x a -> f y b -> Maybe ('(x, a) :~: '(y, b))
forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery (ShelleyBlock proto era) x a
-> BlockQuery (ShelleyBlock proto era) y b
-> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 BlockQuery (ShelleyBlock proto era) x result
q BlockQuery (ShelleyBlock proto era) y result
q'
  sameDepIndex2 (GetCBOR BlockQuery (ShelleyBlock proto era) x result
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2
    (GetFilteredDelegationsAndRewardAccounts Set (Credential 'Staking)
creds)
    (GetFilteredDelegationsAndRewardAccounts Set (Credential 'Staking)
creds')
      | Set (Credential 'Staking)
creds Set (Credential 'Staking) -> Set (Credential 'Staking) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Credential 'Staking)
creds' =
          ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
      | Bool
otherwise =
          Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetFilteredDelegationsAndRewardAccounts Set (Credential 'Staking)
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetGenesisConfig BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetGenesisConfig =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetGenesisConfig BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
DebugNewEpochState BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
DebugNewEpochState =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
DebugNewEpochState BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
DebugChainDepState BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
DebugChainDepState =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
DebugChainDepState BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetRewardProvenance BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetRewardProvenance =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetRewardProvenance BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetUTxOByTxIn Set TxIn
addrs) (GetUTxOByTxIn Set TxIn
addrs')
    | Set TxIn
addrs Set TxIn -> Set TxIn -> Bool
forall a. Eq a => a -> a -> Bool
== Set TxIn
addrs' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetUTxOByTxIn Set TxIn
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetStakePools BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetStakePools =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetStakePools BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetStakePoolParams Set (KeyHash 'StakePool)
poolids) (GetStakePoolParams Set (KeyHash 'StakePool)
poolids')
    | Set (KeyHash 'StakePool)
poolids Set (KeyHash 'StakePool) -> Set (KeyHash 'StakePool) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (KeyHash 'StakePool)
poolids' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetStakePoolParams Set (KeyHash 'StakePool)
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetRewardInfoPools BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetRewardInfoPools =
    ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetRewardInfoPools BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetPoolState Maybe (Set (KeyHash 'StakePool))
poolids) (GetPoolState Maybe (Set (KeyHash 'StakePool))
poolids')
    | Maybe (Set (KeyHash 'StakePool))
poolids Maybe (Set (KeyHash 'StakePool))
-> Maybe (Set (KeyHash 'StakePool)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Set (KeyHash 'StakePool))
poolids' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetPoolState Maybe (Set (KeyHash 'StakePool))
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetStakeSnapshots Maybe (Set (KeyHash 'StakePool))
poolid) (GetStakeSnapshots Maybe (Set (KeyHash 'StakePool))
poolid')
    | Maybe (Set (KeyHash 'StakePool))
poolid Maybe (Set (KeyHash 'StakePool))
-> Maybe (Set (KeyHash 'StakePool)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Set (KeyHash 'StakePool))
poolid' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetStakeSnapshots Maybe (Set (KeyHash 'StakePool))
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetPoolDistr Maybe (Set (KeyHash 'StakePool))
poolids) (GetPoolDistr Maybe (Set (KeyHash 'StakePool))
poolids')
    | Maybe (Set (KeyHash 'StakePool))
poolids Maybe (Set (KeyHash 'StakePool))
-> Maybe (Set (KeyHash 'StakePool)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Set (KeyHash 'StakePool))
poolids' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetPoolDistr Maybe (Set (KeyHash 'StakePool))
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetStakeDelegDeposits Set (Credential 'Staking)
stakeCreds) (GetStakeDelegDeposits Set (Credential 'Staking)
stakeCreds')
    | Set (Credential 'Staking)
stakeCreds Set (Credential 'Staking) -> Set (Credential 'Staking) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Credential 'Staking)
stakeCreds' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetStakeDelegDeposits Set (Credential 'Staking)
_) BlockQuery (ShelleyBlock proto era) y b
_ =
    Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetConstitution BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetConstitution = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetConstitution BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetGovState BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetGovState = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetGovState BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetDRepState{} GetDRepState{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 GetDRepState{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetDRepStakeDistr{} GetDRepStakeDistr{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 GetDRepStakeDistr{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetCommitteeMembersState{} GetCommitteeMembersState{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 GetCommitteeMembersState{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 (GetFilteredVoteDelegatees Set (Credential 'Staking)
stakeCreds) (GetFilteredVoteDelegatees Set (Credential 'Staking)
stakeCreds')
    | Set (Credential 'Staking)
stakeCreds Set (Credential 'Staking) -> Set (Credential 'Staking) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Credential 'Staking)
stakeCreds' =
        ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise =
        Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetFilteredVoteDelegatees{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetAccountState{} GetAccountState{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 GetAccountState{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetSPOStakeDistr{} GetSPOStakeDistr{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 GetSPOStakeDistr{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetProposals{} GetProposals{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 GetProposals{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetRatifyState{} GetRatifyState{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 GetRatifyState{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 GetFuturePParams{} GetFuturePParams{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 GetFuturePParams{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetBigLedgerPeerSnapshot BlockQuery (ShelleyBlock proto era) y b
R:BlockQueryShelleyBlockfpresult proto era y b
GetBigLedgerPeerSnapshot = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 BlockQuery (ShelleyBlock proto era) x a
R:BlockQueryShelleyBlockfpresult proto era x a
GetBigLedgerPeerSnapshot BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing
  sameDepIndex2 QueryStakePoolDefaultVote{} QueryStakePoolDefaultVote{} = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl
  sameDepIndex2 QueryStakePoolDefaultVote{} BlockQuery (ShelleyBlock proto era) y b
_ = Maybe ('(x, a) :~: '(y, b))
forall a. Maybe a
Nothing

deriving instance Eq (BlockQuery (ShelleyBlock proto era) fp result)
deriving instance Show (BlockQuery (ShelleyBlock proto era) fp result)

instance ShelleyCompatible proto era => ShowQuery (BlockQuery (ShelleyBlock proto era) fp) where
  showResult :: forall result.
BlockQuery (ShelleyBlock proto era) fp result -> result -> String
showResult = \case
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetLedgerTip -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetEpochNo -> result -> String
forall a. Show a => a -> String
show
    GetNonMyopicMemberRewards{} -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetCurrentPParams -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetProposedPParamsUpdates -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakeDistribution -> result -> String
forall a. Show a => a -> String
show
    GetUTxOByAddress{} -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetUTxOWhole -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugEpochState -> result -> String
forall a. Show a => a -> String
show
    GetCBOR{} -> result -> String
forall a. Show a => a -> String
show
    GetFilteredDelegationsAndRewardAccounts{} -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGenesisConfig -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugNewEpochState -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugChainDepState -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardProvenance -> result -> String
forall a. Show a => a -> String
show
    GetUTxOByTxIn{} -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakePools -> result -> String
forall a. Show a => a -> String
show
    GetStakePoolParams{} -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardInfoPools -> result -> String
forall a. Show a => a -> String
show
    GetPoolState{} -> result -> String
forall a. Show a => a -> String
show
    GetStakeSnapshots{} -> result -> String
forall a. Show a => a -> String
show
    GetPoolDistr{} -> result -> String
forall a. Show a => a -> String
show
    GetStakeDelegDeposits{} -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetConstitution -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGovState -> result -> String
forall a. Show a => a -> String
show
    GetDRepState{} -> result -> String
forall a. Show a => a -> String
show
    GetDRepStakeDistr{} -> result -> String
forall a. Show a => a -> String
show
    GetCommitteeMembersState{} -> result -> String
forall a. Show a => a -> String
show
    GetFilteredVoteDelegatees{} -> result -> String
forall a. Show a => a -> String
show
    GetAccountState{} -> result -> String
forall a. Show a => a -> String
show
    GetSPOStakeDistr{} -> result -> String
forall a. Show a => a -> String
show
    GetProposals{} -> result -> String
forall a. Show a => a -> String
show
    GetRatifyState{} -> result -> String
forall a. Show a => a -> String
show
    GetFuturePParams{} -> result -> String
forall a. Show a => a -> String
show
    BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetBigLedgerPeerSnapshot -> result -> String
forall a. Show a => a -> String
show
    QueryStakePoolDefaultVote{} -> result -> String
forall a. Show a => a -> String
show

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

-- Get the current 'EpochState.' This is mainly for debugging.
getEpochState :: SL.NewEpochState era -> SL.EpochState era
getEpochState :: forall era. NewEpochState era -> EpochState era
getEpochState = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
SL.nesEs

getDState :: SL.EraCertState era => SL.NewEpochState era -> SL.DState era
getDState :: forall era. EraCertState era => NewEpochState era -> DState era
getDState = Getting (DState era) (CertState era) (DState era)
-> CertState era -> DState era
forall a s. Getting a s a -> s -> a
view Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
SL.certDStateL (CertState era -> DState era)
-> (NewEpochState era -> CertState era)
-> NewEpochState era
-> DState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
SL.lsCertState (LedgerState era -> CertState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> CertState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
SL.esLState (EpochState era -> LedgerState era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> LedgerState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
SL.nesEs

getFilteredDelegationsAndRewardAccounts ::
  SL.EraCertState era =>
  SL.NewEpochState era ->
  Set (SL.Credential 'SL.Staking) ->
  (Delegations, Map (SL.Credential 'Staking) Coin)
getFilteredDelegationsAndRewardAccounts :: forall era.
EraCertState era =>
NewEpochState era
-> Set (Credential 'Staking)
-> (Delegations, Map (Credential 'Staking) Coin)
getFilteredDelegationsAndRewardAccounts NewEpochState era
ss Set (Credential 'Staking)
creds =
  (Delegations
filteredDelegations, Map (Credential 'Staking) Coin
filteredRwdAcnts)
 where
  UMap Map (Credential 'Staking) UMElem
umElems Map Ptr (Credential 'Staking)
_ = DState era -> UMap
forall era. DState era -> UMap
SL.dsUnified (DState era -> UMap) -> DState era -> UMap
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> DState era
forall era. EraCertState era => NewEpochState era -> DState era
getDState NewEpochState era
ss
  umElemsRestricted :: Map (Credential 'Staking) UMElem
umElemsRestricted = Map (Credential 'Staking) UMElem
-> Set (Credential 'Staking) -> Map (Credential 'Staking) UMElem
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking) UMElem
umElems Set (Credential 'Staking)
creds

  filteredDelegations :: Delegations
filteredDelegations = (UMElem -> Maybe (KeyHash 'StakePool))
-> Map (Credential 'Staking) UMElem -> Delegations
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe (KeyHash 'StakePool)
umElemSPool Map (Credential 'Staking) UMElem
umElemsRestricted
  filteredRwdAcnts :: Map (Credential 'Staking) Coin
filteredRwdAcnts =
    (UMElem -> Maybe Coin)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) Coin
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe ((RDPair -> Coin) -> Maybe RDPair -> Maybe Coin
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (RDPair -> CompactForm Coin) -> RDPair -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdReward) (Maybe RDPair -> Maybe Coin)
-> (UMElem -> Maybe RDPair) -> UMElem -> Maybe Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMElem -> Maybe RDPair
umElemRDPair) Map (Credential 'Staking) UMElem
umElemsRestricted

getFilteredVoteDelegatees ::
  SL.EraCertState era =>
  SL.NewEpochState era ->
  Set (SL.Credential 'SL.Staking) ->
  VoteDelegatees
getFilteredVoteDelegatees :: forall era.
EraCertState era =>
NewEpochState era
-> Set (Credential 'Staking) -> Map (Credential 'Staking) DRep
getFilteredVoteDelegatees NewEpochState era
ss Set (Credential 'Staking)
creds = (UMElem -> Maybe DRep)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) DRep
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe UMElem -> Maybe DRep
umElemDRep Map (Credential 'Staking) UMElem
umElemsRestricted
 where
  UMap Map (Credential 'Staking) UMElem
umElems Map Ptr (Credential 'Staking)
_ = DState era -> UMap
forall era. DState era -> UMap
SL.dsUnified (DState era -> UMap) -> DState era -> UMap
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> DState era
forall era. EraCertState era => NewEpochState era -> DState era
getDState NewEpochState era
ss
  umElemsRestricted :: Map (Credential 'Staking) UMElem
umElemsRestricted = Map (Credential 'Staking) UMElem
-> Set (Credential 'Staking) -> Map (Credential 'Staking) UMElem
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking) UMElem
umElems Set (Credential 'Staking)
creds

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

encodeShelleyQuery ::
  forall era proto fp result.
  ShelleyBasedEra era =>
  BlockQuery (ShelleyBlock proto era) fp result -> Encoding
encodeShelleyQuery :: forall era proto (fp :: QueryFootprint) result.
ShelleyBasedEra era =>
BlockQuery (ShelleyBlock proto era) fp result -> Encoding
encodeShelleyQuery BlockQuery (ShelleyBlock proto era) fp result
query = case BlockQuery (ShelleyBlock proto era) fp result
query of
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetLedgerTip ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
0
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetEpochNo ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
1
  GetNonMyopicMemberRewards Set (Either Coin (Credential 'Staking))
creds ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (Either Coin (Credential 'Staking)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Either Coin (Credential 'Staking))
creds
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetCurrentPParams ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
3
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetProposedPParamsUpdates ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
4
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakeDistribution ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
5
  GetUTxOByAddress Set Addr
addrs ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
6 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era Set Addr
addrs
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetUTxOWhole ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
7
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugEpochState ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
8
  GetCBOR BlockQuery (ShelleyBlock proto era) fp result
query' ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
9 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlockQuery (ShelleyBlock proto era) fp result -> Encoding
forall era proto (fp :: QueryFootprint) result.
ShelleyBasedEra era =>
BlockQuery (ShelleyBlock proto era) fp result -> Encoding
encodeShelleyQuery BlockQuery (ShelleyBlock proto era) fp result
query'
  GetFilteredDelegationsAndRewardAccounts Set (Credential 'Staking)
creds ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
10 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era Set (Credential 'Staking)
creds
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGenesisConfig ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
11
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugNewEpochState ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
12
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugChainDepState ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
13
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardProvenance ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
14
  GetUTxOByTxIn Set TxIn
txins ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
15 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era Set TxIn
txins
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakePools ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
16
  GetStakePoolParams Set (KeyHash 'StakePool)
poolids ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
17 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (KeyHash 'StakePool) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (KeyHash 'StakePool)
poolids
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardInfoPools ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
18
  GetPoolState Maybe (Set (KeyHash 'StakePool))
poolids ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
19 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (Set (KeyHash 'StakePool)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe (Set (KeyHash 'StakePool))
poolids
  GetStakeSnapshots Maybe (Set (KeyHash 'StakePool))
poolId ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
20 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (Set (KeyHash 'StakePool)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe (Set (KeyHash 'StakePool))
poolId
  GetPoolDistr Maybe (Set (KeyHash 'StakePool))
poolids ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
21 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (Set (KeyHash 'StakePool)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe (Set (KeyHash 'StakePool))
poolids
  GetStakeDelegDeposits Set (Credential 'Staking)
stakeCreds ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
22 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (Credential 'Staking) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Credential 'Staking)
stakeCreds
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetConstitution ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
23
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGovState ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
24
  GetDRepState Set (Credential 'DRepRole)
drepCreds ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
25 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (Credential 'DRepRole) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Credential 'DRepRole)
drepCreds
  GetDRepStakeDistr Set DRep
dreps ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
26 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era Set DRep
dreps
  GetCommitteeMembersState Set (Credential 'ColdCommitteeRole)
coldCreds Set (Credential 'HotCommitteeRole)
hotCreds Set MemberStatus
statuses ->
    Word -> Encoding
CBOR.encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
27
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (Credential 'ColdCommitteeRole) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Credential 'ColdCommitteeRole)
coldCreds
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (Credential 'HotCommitteeRole) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Credential 'HotCommitteeRole)
hotCreds
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era Set MemberStatus
statuses
  GetFilteredVoteDelegatees Set (Credential 'Staking)
stakeCreds ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
28 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era Set (Credential 'Staking)
stakeCreds
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetAccountState ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
29
  GetSPOStakeDistr Set (KeyHash 'StakePool)
keys ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
30 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era Set (KeyHash 'StakePool)
keys
  GetProposals Set GovActionId
gids ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
31 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era Set GovActionId
gids
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRatifyState ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
32
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetFuturePParams ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
33
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetBigLedgerPeerSnapshot ->
    Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
34
  QueryStakePoolDefaultVote KeyHash 'StakePool
stakePoolKey ->
    Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
35 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era KeyHash 'StakePool
stakePoolKey

decodeShelleyQuery ::
  forall era proto.
  ShelleyBasedEra era =>
  forall s.
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
decodeShelleyQuery :: forall era proto s.
ShelleyBasedEra era =>
Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
decodeShelleyQuery = do
  len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
  tag <- CBOR.decodeWord8

  let failmsg :: forall s ans. String -> Decoder s ans
      failmsg String
msg =
        String -> Decoder s ans
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ans) -> String -> Decoder s ans
forall a b. (a -> b) -> a -> b
$
          String
"decodeShelleyQuery: "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (len, tag) = ("
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
len
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
tag
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

      requireCG ::
        forall s ans.
        (CG.ConwayEraGov era => Decoder s ans) ->
        Decoder s ans
      requireCG ConwayEraGov era => Decoder s ans
k = case Proxy era -> Maybe (ConwayEraGovDict era)
forall era (proxy :: * -> *).
ShelleyBasedEra era =>
proxy era -> Maybe (ConwayEraGovDict era)
forall (proxy :: * -> *). proxy era -> Maybe (ConwayEraGovDict era)
SE.getConwayEraGovDict (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @era) of
        Just ConwayEraGovDict era
SE.ConwayEraGovDict -> Decoder s ans
ConwayEraGov era => Decoder s ans
k
        Maybe (ConwayEraGovDict era)
Nothing -> String -> Decoder s ans
forall s ans. String -> Decoder s ans
failmsg String
"that query is not supported before Conway,"

  case (len, tag) of
    (Int
1, Word8
0) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Point (ShelleyBlock proto era))
GetLedgerTip
    (Int
1, Word8
1) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
GetEpochNo
    (Int
2, Word8
2) -> BlockQuery
  (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (Either Coin (Credential 'Staking))
    -> BlockQuery
         (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards)
-> Set (Either Coin (Credential 'Staking))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either Coin (Credential 'Staking))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
forall proto era.
Set (Either Coin (Credential 'Staking))
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
GetNonMyopicMemberRewards (Set (Either Coin (Credential 'Staking))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set (Either Coin (Credential 'Staking)))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Either Coin (Credential 'Staking)))
forall s. Decoder s (Set (Either Coin (Credential 'Staking)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (Int
1, Word8
3) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
GetCurrentPParams
    (Int
1, Word8
4) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ProposedPPUpdates era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ProposedPPUpdates era)
forall proto era.
BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ProposedPPUpdates era)
GetProposedPParamsUpdates
    (Int
1, Word8
5) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto proto))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto proto))
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto proto))
GetStakeDistribution
    (Int
2, Word8
6) -> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set Addr
    -> BlockQuery
         (ShelleyBlock proto era) 'QFTraverseTables (UTxO era))
-> Set Addr
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Addr
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
forall proto era.
Set Addr
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
GetUTxOByAddress (Set Addr -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set Addr)
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
    (Int
1, Word8
7) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables (UTxO era)
GetUTxOWhole
    (Int
1, Word8
8) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
DebugEpochState
    (Int
2, Word8
9) -> (\(SomeBlockQuery BlockQuery (ShelleyBlock proto era) footprint result
q) -> BlockQuery (ShelleyBlock proto era) footprint (Serialised result)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) footprint result
-> BlockQuery
     (ShelleyBlock proto era) footprint (Serialised result)
forall proto era (fp :: QueryFootprint) result.
BlockQuery (ShelleyBlock proto era) fp result
-> BlockQuery (ShelleyBlock proto era) fp (Serialised result)
GetCBOR BlockQuery (ShelleyBlock proto era) footprint result
q)) (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s.
Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall era proto s.
ShelleyBasedEra era =>
Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
decodeShelleyQuery
    (Int
2, Word8
10) -> BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Delegations, Map (Credential 'Staking) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Delegations, Map (Credential 'Staking) Coin)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (Credential 'Staking)
    -> BlockQuery
         (ShelleyBlock proto era)
         'QFNoTables
         (Delegations, Map (Credential 'Staking) Coin))
-> Set (Credential 'Staking)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Delegations, Map (Credential 'Staking) Coin)
forall proto era.
Set (Credential 'Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Delegations, Map (Credential 'Staking) Coin)
GetFilteredDelegationsAndRewardAccounts (Set (Credential 'Staking)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set (Credential 'Staking))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
    (Int
1, Word8
11) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig
    (Int
1, Word8
12) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
DebugNewEpochState
    (Int
1, Word8
13) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ChainDepState proto)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ChainDepState proto)
forall proto era.
BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (ChainDepState proto)
DebugChainDepState
    (Int
1, Word8
14) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables RewardProvenance
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables RewardProvenance
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables RewardProvenance
GetRewardProvenance
    (Int
2, Word8
15) -> BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set TxIn
    -> BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era))
-> Set TxIn
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TxIn
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
forall proto era.
Set TxIn
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables (UTxO era)
GetUTxOByTxIn (Set TxIn -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set TxIn)
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
    (Int
1, Word8
16) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Set (KeyHash 'StakePool))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Set (KeyHash 'StakePool))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Set (KeyHash 'StakePool))
GetStakePools
    (Int
2, Word8
17) -> BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (KeyHash 'StakePool) PoolParams)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (KeyHash 'StakePool) PoolParams)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (KeyHash 'StakePool)
    -> BlockQuery
         (ShelleyBlock proto era)
         'QFNoTables
         (Map (KeyHash 'StakePool) PoolParams))
-> Set (KeyHash 'StakePool)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (KeyHash 'StakePool)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (KeyHash 'StakePool) PoolParams)
forall proto era.
Set (KeyHash 'StakePool)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (KeyHash 'StakePool) PoolParams)
GetStakePoolParams (Set (KeyHash 'StakePool)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set (KeyHash 'StakePool))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (KeyHash 'StakePool))
forall s. Decoder s (Set (KeyHash 'StakePool))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (Int
1, Word8
18) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (RewardParams, Map (KeyHash 'StakePool) RewardInfoPool)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (RewardParams, Map (KeyHash 'StakePool) RewardInfoPool)
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (RewardParams, Map (KeyHash 'StakePool) RewardInfoPool)
GetRewardInfoPools
    (Int
2, Word8
19) -> BlockQuery (ShelleyBlock proto era) 'QFNoTables (PState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFNoTables (PState era)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Maybe (Set (KeyHash 'StakePool))
    -> BlockQuery (ShelleyBlock proto era) 'QFNoTables (PState era))
-> Maybe (Set (KeyHash 'StakePool))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Set (KeyHash 'StakePool))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables (PState era)
forall proto era.
Maybe (Set (KeyHash 'StakePool))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables (PState era)
GetPoolState (Maybe (Set (KeyHash 'StakePool))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Maybe (Set (KeyHash 'StakePool)))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe (Set (KeyHash 'StakePool)))
forall s. Decoder s (Maybe (Set (KeyHash 'StakePool)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (Int
2, Word8
20) -> BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Maybe (Set (KeyHash 'StakePool))
    -> BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots)
-> Maybe (Set (KeyHash 'StakePool))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Set (KeyHash 'StakePool))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
forall proto era.
Maybe (Set (KeyHash 'StakePool))
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables StakeSnapshots
GetStakeSnapshots (Maybe (Set (KeyHash 'StakePool))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Maybe (Set (KeyHash 'StakePool)))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe (Set (KeyHash 'StakePool)))
forall s. Decoder s (Maybe (Set (KeyHash 'StakePool)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (Int
2, Word8
21) -> BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (PoolDistr (ProtoCrypto proto))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (PoolDistr (ProtoCrypto proto))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Maybe (Set (KeyHash 'StakePool))
    -> BlockQuery
         (ShelleyBlock proto era)
         'QFNoTables
         (PoolDistr (ProtoCrypto proto)))
-> Maybe (Set (KeyHash 'StakePool))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Set (KeyHash 'StakePool))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (PoolDistr (ProtoCrypto proto))
forall proto era.
Maybe (Set (KeyHash 'StakePool))
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (PoolDistr (ProtoCrypto proto))
GetPoolDistr (Maybe (Set (KeyHash 'StakePool))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Maybe (Set (KeyHash 'StakePool)))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe (Set (KeyHash 'StakePool)))
forall s. Decoder s (Maybe (Set (KeyHash 'StakePool)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (Int
2, Word8
22) -> BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (Credential 'Staking) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (Credential 'Staking) Coin)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (Credential 'Staking)
    -> BlockQuery
         (ShelleyBlock proto era)
         'QFNoTables
         (Map (Credential 'Staking) Coin))
-> Set (Credential 'Staking)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential 'Staking) Coin)
forall proto era.
Set (Credential 'Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential 'Staking) Coin)
GetStakeDelegDeposits (Set (Credential 'Staking)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set (Credential 'Staking))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Credential 'Staking))
forall s. Decoder s (Set (Credential 'Staking))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (Int
1, Word8
23) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (Constitution era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (Constitution era)
forall era proto.
ConwayEraGov era =>
BlockQuery (ShelleyBlock proto era) 'QFNoTables (Constitution era)
GetConstitution
    (Int
1, Word8
24) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (GovState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (GovState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (GovState era)
GetGovState
    (Int
2, Word8
25) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (Credential 'DRepRole) DRepState)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (Credential 'DRepRole) DRepState)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (Credential 'DRepRole)
    -> BlockQuery
         (ShelleyBlock proto era)
         'QFNoTables
         (Map (Credential 'DRepRole) DRepState))
-> Set (Credential 'DRepRole)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'DRepRole)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential 'DRepRole) DRepState)
forall era proto.
ConwayEraGov era =>
Set (Credential 'DRepRole)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential 'DRepRole) DRepState)
GetDRepState (Set (Credential 'DRepRole)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set (Credential 'DRepRole))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Credential 'DRepRole))
forall s. Decoder s (Set (Credential 'DRepRole))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    (Int
2, Word8
26) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set DRep
    -> BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin))
-> Set DRep
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set DRep
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
forall era proto.
ConwayEraGov era =>
Set DRep
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables (Map DRep Coin)
GetDRepStakeDistr (Set DRep -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set DRep)
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
    (Int
4, Word8
27) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ do
      coldCreds <- Decoder s (Set (Credential 'ColdCommitteeRole))
forall s. Decoder s (Set (Credential 'ColdCommitteeRole))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      hotCreds <- fromCBOR
      statuses <- LC.fromEraCBOR @era
      return $ SomeBlockQuery $ GetCommitteeMembersState coldCreds hotCreds statuses
    (Int
2, Word8
28) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ do
      BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (Credential 'Staking) DRep)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (Credential 'Staking) DRep)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (Credential 'Staking)
    -> BlockQuery
         (ShelleyBlock proto era)
         'QFNoTables
         (Map (Credential 'Staking) DRep))
-> Set (Credential 'Staking)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential 'Staking) DRep)
forall era proto.
ConwayEraGov era =>
Set (Credential 'Staking)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (Credential 'Staking) DRep)
GetFilteredVoteDelegatees (Set (Credential 'Staking)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set (Credential 'Staking))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
    (Int
1, Word8
29) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables AccountState
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables AccountState
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables AccountState
GetAccountState
    (Int
2, Word8
30) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era)
  'QFNoTables
  (Map (KeyHash 'StakePool) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era)
   'QFNoTables
   (Map (KeyHash 'StakePool) Coin)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (KeyHash 'StakePool)
    -> BlockQuery
         (ShelleyBlock proto era)
         'QFNoTables
         (Map (KeyHash 'StakePool) Coin))
-> Set (KeyHash 'StakePool)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (KeyHash 'StakePool)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (KeyHash 'StakePool) Coin)
forall era proto.
ConwayEraGov era =>
Set (KeyHash 'StakePool)
-> BlockQuery
     (ShelleyBlock proto era)
     'QFNoTables
     (Map (KeyHash 'StakePool) Coin)
GetSPOStakeDistr (Set (KeyHash 'StakePool)
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set (KeyHash 'StakePool))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
    (Int
2, Word8
31) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
   (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set GovActionId
    -> BlockQuery
         (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era)))
-> Set GovActionId
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set GovActionId
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
forall era proto.
ConwayEraGov era =>
Set GovActionId
-> BlockQuery
     (ShelleyBlock proto era) 'QFNoTables (Seq (GovActionState era))
GetProposals (Set GovActionId
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (Set GovActionId)
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
    (Int
1, Word8
32) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (RatifyState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (RatifyState era)
forall era proto.
ConwayEraGov era =>
BlockQuery (ShelleyBlock proto era) 'QFNoTables (RatifyState era)
GetRatifyState
    (Int
1, Word8
33) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Maybe (PParams era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Maybe (PParams era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) 'QFNoTables (Maybe (PParams era))
GetFuturePParams
    (Int
1, Word8
34) -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables LedgerPeerSnapshot
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables LedgerPeerSnapshot
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables LedgerPeerSnapshot
GetBigLedgerPeerSnapshot
    (Int
2, Word8
35) -> (ConwayEraGov era =>
 Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. (ConwayEraGov era => Decoder s ans) -> Decoder s ans
requireCG ((ConwayEraGov era =>
  Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
 -> Decoder
      s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> (ConwayEraGov era =>
    Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (KeyHash 'StakePool
    -> BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote)
-> KeyHash 'StakePool
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
forall era proto.
ConwayEraGov era =>
KeyHash 'StakePool
-> BlockQuery (ShelleyBlock proto era) 'QFNoTables DefaultVote
QueryStakePoolDefaultVote (KeyHash 'StakePool
 -> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Decoder s (KeyHash 'StakePool)
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
    (Int, Word8)
_ -> String
-> Decoder s (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall s ans. String -> Decoder s ans
failmsg String
"invalid"

encodeShelleyResult ::
  forall proto era fp result.
  ShelleyCompatible proto era =>
  ShelleyNodeToClientVersion ->
  BlockQuery (ShelleyBlock proto era) fp result ->
  result ->
  Encoding
encodeShelleyResult :: forall proto era (fp :: QueryFootprint) result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) fp result
-> result
-> Encoding
encodeShelleyResult ShelleyNodeToClientVersion
_v BlockQuery (ShelleyBlock proto era) fp result
query = case BlockQuery (ShelleyBlock proto era) fp result
query of
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetLedgerTip -> (HeaderHash (ShelleyBlock proto era) -> Encoding)
-> Point (ShelleyBlock proto era) -> Encoding
forall {k} (block :: k).
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint HeaderHash (ShelleyBlock proto era) -> Encoding
ShelleyHash -> Encoding
forall a. Serialise a => a -> Encoding
encode
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetEpochNo -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  GetNonMyopicMemberRewards{} -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetCurrentPParams -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetProposedPParamsUpdates -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakeDistribution -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetUTxOByAddress{} -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetUTxOWhole -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugEpochState -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  GetCBOR{} -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
  GetFilteredDelegationsAndRewardAccounts{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGenesisConfig -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugNewEpochState -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugChainDepState -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardProvenance -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetUTxOByTxIn{} -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakePools -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  GetStakePoolParams{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardInfoPools -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetPoolState{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetStakeSnapshots{} -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  GetPoolDistr{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetStakeDelegDeposits{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetConstitution -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGovState -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  GetDRepState{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetDRepStakeDistr{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetCommitteeMembersState{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetFilteredVoteDelegatees{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetAccountState{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetSPOStakeDistr{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetProposals{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetRatifyState{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  GetFuturePParams{} -> forall era t. (Era era, EncCBOR t) => t -> Encoding
LC.toEraCBOR @era
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetBigLedgerPeerSnapshot -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  QueryStakePoolDefaultVote{} -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

decodeShelleyResult ::
  forall proto era fp result.
  ShelleyCompatible proto era =>
  ShelleyNodeToClientVersion ->
  BlockQuery (ShelleyBlock proto era) fp result ->
  forall s.
  Decoder s result
decodeShelleyResult :: forall proto era (fp :: QueryFootprint) result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) fp result
-> forall s. Decoder s result
decodeShelleyResult ShelleyNodeToClientVersion
_v BlockQuery (ShelleyBlock proto era) fp result
query = case BlockQuery (ShelleyBlock proto era) fp result
query of
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetLedgerTip -> (forall s. Decoder s (HeaderHash (ShelleyBlock proto era)))
-> forall s. Decoder s (Point (ShelleyBlock proto era))
forall {k} (block :: k).
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint Decoder s (HeaderHash (ShelleyBlock proto era))
Decoder s ShelleyHash
forall s. Decoder s (HeaderHash (ShelleyBlock proto era))
forall s. Decoder s ShelleyHash
forall a s. Serialise a => Decoder s a
decode
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetEpochNo -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  GetNonMyopicMemberRewards{} -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetCurrentPParams -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetProposedPParamsUpdates -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakeDistribution -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetUTxOByAddress{} -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetUTxOWhole -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugEpochState -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  GetCBOR{} -> Decoder s result
forall s. Decoder s result
forall a s. Serialise a => Decoder s a
decode
  GetFilteredDelegationsAndRewardAccounts{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGenesisConfig -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugNewEpochState -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
DebugChainDepState -> Decoder s result
forall s. Decoder s result
forall a s. Serialise a => Decoder s a
decode
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardProvenance -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetUTxOByTxIn{} -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetStakePools -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  GetStakePoolParams{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetRewardInfoPools -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetPoolState{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetStakeSnapshots{} -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  GetPoolDistr{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetStakeDelegDeposits{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetConstitution -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetGovState -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  GetDRepState{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetDRepStakeDistr{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetCommitteeMembersState{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetFilteredVoteDelegatees{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetAccountState{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetSPOStakeDistr{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetProposals{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetRatifyState{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  GetFuturePParams{} -> forall era t s. (Era era, DecCBOR t) => Decoder s t
LC.fromEraCBOR @era
  BlockQuery (ShelleyBlock proto era) fp result
R:BlockQueryShelleyBlockfpresult proto era fp result
GetBigLedgerPeerSnapshot -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
  QueryStakePoolDefaultVote{} -> Decoder s result
forall s. Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- | The stake snapshot returns information about the mark, set, go ledger snapshots for a pool,
-- plus the total active stake for each snapshot that can be used in a 'sigma' calculation.
--
-- Each snapshot is taken at the end of a different era. The go snapshot is the current one and
-- was taken two epochs earlier, set was taken one epoch ago, and mark was taken immediately
-- before the start of the current epoch.
data StakeSnapshot = StakeSnapshot
  { StakeSnapshot -> Coin
ssMarkPool :: !SL.Coin
  , StakeSnapshot -> Coin
ssSetPool :: !SL.Coin
  , StakeSnapshot -> Coin
ssGoPool :: !SL.Coin
  }
  deriving (StakeSnapshot -> StakeSnapshot -> Bool
(StakeSnapshot -> StakeSnapshot -> Bool)
-> (StakeSnapshot -> StakeSnapshot -> Bool) -> Eq StakeSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakeSnapshot -> StakeSnapshot -> Bool
== :: StakeSnapshot -> StakeSnapshot -> Bool
$c/= :: StakeSnapshot -> StakeSnapshot -> Bool
/= :: StakeSnapshot -> StakeSnapshot -> Bool
Eq, Int -> StakeSnapshot -> ShowS
[StakeSnapshot] -> ShowS
StakeSnapshot -> String
(Int -> StakeSnapshot -> ShowS)
-> (StakeSnapshot -> String)
-> ([StakeSnapshot] -> ShowS)
-> Show StakeSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakeSnapshot -> ShowS
showsPrec :: Int -> StakeSnapshot -> ShowS
$cshow :: StakeSnapshot -> String
show :: StakeSnapshot -> String
$cshowList :: [StakeSnapshot] -> ShowS
showList :: [StakeSnapshot] -> ShowS
Show, (forall x. StakeSnapshot -> Rep StakeSnapshot x)
-> (forall x. Rep StakeSnapshot x -> StakeSnapshot)
-> Generic StakeSnapshot
forall x. Rep StakeSnapshot x -> StakeSnapshot
forall x. StakeSnapshot -> Rep StakeSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakeSnapshot -> Rep StakeSnapshot x
from :: forall x. StakeSnapshot -> Rep StakeSnapshot x
$cto :: forall x. Rep StakeSnapshot x -> StakeSnapshot
to :: forall x. Rep StakeSnapshot x -> StakeSnapshot
Generic)

instance NFData StakeSnapshot

instance ToCBOR StakeSnapshot where
  toCBOR :: StakeSnapshot -> Encoding
toCBOR
    StakeSnapshot
      { Coin
ssMarkPool :: StakeSnapshot -> Coin
ssMarkPool :: Coin
ssMarkPool
      , Coin
ssSetPool :: StakeSnapshot -> Coin
ssSetPool :: Coin
ssSetPool
      , Coin
ssGoPool :: StakeSnapshot -> Coin
ssGoPool :: Coin
ssGoPool
      } =
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
ssMarkPool
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
ssSetPool
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
ssGoPool

instance FromCBOR StakeSnapshot where
  fromCBOR :: forall s. Decoder s StakeSnapshot
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"StakeSnapshot" Int
3
    Coin -> Coin -> Coin -> StakeSnapshot
StakeSnapshot
      (Coin -> Coin -> Coin -> StakeSnapshot)
-> Decoder s Coin -> Decoder s (Coin -> Coin -> StakeSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Coin
forall s. Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Coin -> Coin -> StakeSnapshot)
-> Decoder s Coin -> Decoder s (Coin -> StakeSnapshot)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Coin
forall s. Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Coin -> StakeSnapshot)
-> Decoder s Coin -> Decoder s StakeSnapshot
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Coin
forall s. Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR

data StakeSnapshots = StakeSnapshots
  { StakeSnapshots -> Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots :: !(Map (SL.KeyHash 'SL.StakePool) StakeSnapshot)
  , StakeSnapshots -> Coin
ssMarkTotal :: !SL.Coin
  , StakeSnapshots -> Coin
ssSetTotal :: !SL.Coin
  , StakeSnapshots -> Coin
ssGoTotal :: !SL.Coin
  }
  deriving (StakeSnapshots -> StakeSnapshots -> Bool
(StakeSnapshots -> StakeSnapshots -> Bool)
-> (StakeSnapshots -> StakeSnapshots -> Bool) -> Eq StakeSnapshots
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StakeSnapshots -> StakeSnapshots -> Bool
== :: StakeSnapshots -> StakeSnapshots -> Bool
$c/= :: StakeSnapshots -> StakeSnapshots -> Bool
/= :: StakeSnapshots -> StakeSnapshots -> Bool
Eq, Int -> StakeSnapshots -> ShowS
[StakeSnapshots] -> ShowS
StakeSnapshots -> String
(Int -> StakeSnapshots -> ShowS)
-> (StakeSnapshots -> String)
-> ([StakeSnapshots] -> ShowS)
-> Show StakeSnapshots
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StakeSnapshots -> ShowS
showsPrec :: Int -> StakeSnapshots -> ShowS
$cshow :: StakeSnapshots -> String
show :: StakeSnapshots -> String
$cshowList :: [StakeSnapshots] -> ShowS
showList :: [StakeSnapshots] -> ShowS
Show, (forall x. StakeSnapshots -> Rep StakeSnapshots x)
-> (forall x. Rep StakeSnapshots x -> StakeSnapshots)
-> Generic StakeSnapshots
forall x. Rep StakeSnapshots x -> StakeSnapshots
forall x. StakeSnapshots -> Rep StakeSnapshots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StakeSnapshots -> Rep StakeSnapshots x
from :: forall x. StakeSnapshots -> Rep StakeSnapshots x
$cto :: forall x. Rep StakeSnapshots x -> StakeSnapshots
to :: forall x. Rep StakeSnapshots x -> StakeSnapshots
Generic)

instance NFData StakeSnapshots

instance ToCBOR StakeSnapshots where
  toCBOR :: StakeSnapshots -> Encoding
toCBOR
    StakeSnapshots
      { Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots :: StakeSnapshots -> Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots :: Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots
      , Coin
ssMarkTotal :: StakeSnapshots -> Coin
ssMarkTotal :: Coin
ssMarkTotal
      , Coin
ssSetTotal :: StakeSnapshots -> Coin
ssSetTotal :: Coin
ssSetTotal
      , Coin
ssGoTotal :: StakeSnapshots -> Coin
ssGoTotal :: Coin
ssGoTotal
      } =
      Word -> Encoding
encodeListLen Word
4
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool) StakeSnapshot -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
ssMarkTotal
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
ssSetTotal
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
ssGoTotal

instance FromCBOR StakeSnapshots where
  fromCBOR :: forall s. Decoder s StakeSnapshots
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"StakeSnapshots" Int
4
    Map (KeyHash 'StakePool) StakeSnapshot
-> Coin -> Coin -> Coin -> StakeSnapshots
StakeSnapshots
      (Map (KeyHash 'StakePool) StakeSnapshot
 -> Coin -> Coin -> Coin -> StakeSnapshots)
-> Decoder s (Map (KeyHash 'StakePool) StakeSnapshot)
-> Decoder s (Coin -> Coin -> Coin -> StakeSnapshots)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (KeyHash 'StakePool) StakeSnapshot)
forall s. Decoder s (Map (KeyHash 'StakePool) StakeSnapshot)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Coin -> Coin -> Coin -> StakeSnapshots)
-> Decoder s Coin -> Decoder s (Coin -> Coin -> StakeSnapshots)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Coin
forall s. Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Coin -> Coin -> StakeSnapshots)
-> Decoder s Coin -> Decoder s (Coin -> StakeSnapshots)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Coin
forall s. Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Coin -> StakeSnapshots)
-> Decoder s Coin -> Decoder s StakeSnapshots
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Coin
forall s. Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR

{-------------------------------------------------------------------------------
 Instances to implement BlockSupportsHFLedgerQuery
-------------------------------------------------------------------------------}

answerShelleyLookupQueries ::
  forall proto era m result blk.
  ( Monad m
  , ShelleyCompatible proto era
  ) =>
  -- | Inject ledger tables
  ( LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK ->
    LedgerTables (LedgerState blk) KeysMK
  ) ->
  -- | Eject TxOut
  (TxOut (LedgerState blk) -> LC.TxOut era) ->
  -- | Eject TxIn
  (TxIn (LedgerState blk) -> SL.TxIn) ->
  ExtLedgerCfg (ShelleyBlock proto era) ->
  BlockQuery (ShelleyBlock proto era) QFLookupTables result ->
  ReadOnlyForker' m blk ->
  m result
answerShelleyLookupQueries :: forall proto era (m :: * -> *) result blk.
(Monad m, ShelleyCompatible proto era) =>
(LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
 -> LedgerTables (LedgerState blk) KeysMK)
-> (TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> ReadOnlyForker' m blk
-> m result
answerShelleyLookupQueries LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
-> LedgerTables (LedgerState blk) KeysMK
injTables TxOut (LedgerState blk) -> TxOut era
ejTxOut TxIn (LedgerState blk) -> TxIn
ejTxIn ExtLedgerCfg (ShelleyBlock proto era)
cfg BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
q ReadOnlyForker' m blk
forker =
  case BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
q of
    GetUTxOByTxIn Set TxIn
txins ->
      Set TxIn -> m (UTxO era)
answerGetUtxOByTxIn Set TxIn
txins
    GetCBOR BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
q' ->
      -- We encode using the latest (@maxBound@) ShelleyNodeToClientVersion,
      -- as the @GetCBOR@ query already is about opportunistically assuming
      -- both client and server are running the same version; cf. the
      -- @GetCBOR@ Haddocks.
      (result -> Encoding) -> result -> Serialised result
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> result
-> Encoding
forall proto era (fp :: QueryFootprint) result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) fp result
-> result
-> Encoding
encodeShelleyResult ShelleyNodeToClientVersion
forall a. Bounded a => a
maxBound BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
q')
        (result -> result) -> m result -> m result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
 -> LedgerTables (LedgerState blk) KeysMK)
-> (TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> ReadOnlyForker' m blk
-> m result
forall proto era (m :: * -> *) result blk.
(Monad m, ShelleyCompatible proto era) =>
(LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
 -> LedgerTables (LedgerState blk) KeysMK)
-> (TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
-> ReadOnlyForker' m blk
-> m result
answerShelleyLookupQueries LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
-> LedgerTables (LedgerState blk) KeysMK
injTables TxOut (LedgerState blk) -> TxOut era
ejTxOut TxIn (LedgerState blk) -> TxIn
ejTxIn ExtLedgerCfg (ShelleyBlock proto era)
cfg BlockQuery (ShelleyBlock proto era) 'QFLookupTables result
q' ReadOnlyForker' m blk
forker
 where
  answerGetUtxOByTxIn ::
    Set.Set SL.TxIn ->
    m (SL.UTxO era)
  answerGetUtxOByTxIn :: Set TxIn -> m (UTxO era)
answerGetUtxOByTxIn Set TxIn
txins = do
    LedgerTables (ValuesMK values) <-
      ReadOnlyForker' m blk
-> LedgerTables (ExtLedgerState blk) KeysMK
-> m (LedgerTables (ExtLedgerState blk) ValuesMK)
forall (m :: * -> *) (l :: LedgerStateKind) blk.
ReadOnlyForker m l blk
-> LedgerTables l KeysMK -> m (LedgerTables l ValuesMK)
LedgerDB.roforkerReadTables
        ReadOnlyForker' m blk
forker
        (LedgerTables (LedgerState blk) KeysMK
-> LedgerTables (ExtLedgerState blk) KeysMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables (LedgerTables (LedgerState blk) KeysMK
 -> LedgerTables (ExtLedgerState blk) KeysMK)
-> LedgerTables (LedgerState blk) KeysMK
-> LedgerTables (ExtLedgerState blk) KeysMK
forall a b. (a -> b) -> a -> b
$ LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
-> LedgerTables (LedgerState blk) KeysMK
injTables (KeysMK
  (TxIn (LedgerState (ShelleyBlock proto era)))
  (TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (KeysMK
   (TxIn (LedgerState (ShelleyBlock proto era)))
   (TxOut (LedgerState (ShelleyBlock proto era)))
 -> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK)
-> KeysMK
     (TxIn (LedgerState (ShelleyBlock proto era)))
     (TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
forall a b. (a -> b) -> a -> b
$ Set TxIn -> KeysMK TxIn (TxOut era)
forall k v. Set k -> KeysMK k v
KeysMK Set TxIn
txins))
    pure $
      SL.UTxO $
        Map.mapKeys ejTxIn $
          Map.mapMaybeWithKey
            ( \TxIn (LedgerState blk)
k TxOut (LedgerState blk)
v ->
                if TxIn (LedgerState blk) -> TxIn
ejTxIn TxIn (LedgerState blk)
k TxIn -> Set TxIn -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TxIn
txins
                  then TxOut era -> Maybe (TxOut era)
forall a. a -> Maybe a
Just (TxOut era -> Maybe (TxOut era)) -> TxOut era -> Maybe (TxOut era)
forall a b. (a -> b) -> a -> b
$ TxOut (LedgerState blk) -> TxOut era
ejTxOut TxOut (LedgerState blk)
v
                  else Maybe (TxOut era)
forall a. Maybe a
Nothing
            )
            values

shelleyQFTraverseTablesPredicate ::
  forall proto era proto' era' result.
  (ShelleyBasedEra era, ShelleyBasedEra era') =>
  BlockQuery (ShelleyBlock proto era) QFTraverseTables result ->
  TxOut (LedgerState (ShelleyBlock proto' era')) ->
  Bool
shelleyQFTraverseTablesPredicate :: forall proto era proto' era' result.
(ShelleyBasedEra era, ShelleyBasedEra era') =>
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> TxOut (LedgerState (ShelleyBlock proto' era')) -> Bool
shelleyQFTraverseTablesPredicate BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q = case BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q of
  GetUTxOByAddress Set Addr
addr -> Set Addr -> TxOut era' -> Bool
filterGetUTxOByAddressOne Set Addr
addr
  BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFTraverseTables result
GetUTxOWhole -> Bool -> TxOut era' -> Bool
forall a b. a -> b -> a
const Bool
True
  GetCBOR BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q' -> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> TxOut (LedgerState (ShelleyBlock Any era')) -> Bool
forall proto era proto' era' result.
(ShelleyBasedEra era, ShelleyBasedEra era') =>
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> TxOut (LedgerState (ShelleyBlock proto' era')) -> Bool
shelleyQFTraverseTablesPredicate BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q'
 where
  filterGetUTxOByAddressOne ::
    Set Addr ->
    LC.TxOut era' ->
    Bool
  filterGetUTxOByAddressOne :: Set Addr -> TxOut era' -> Bool
filterGetUTxOByAddressOne Set Addr
addrs =
    let
      compactAddrSet :: Set CompactAddr
compactAddrSet = (Addr -> CompactAddr) -> Set Addr -> Set CompactAddr
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Addr -> CompactAddr
compactAddr Set Addr
addrs
      checkAddr :: TxOut era' -> Bool
checkAddr TxOut era'
out =
        case TxOut era'
out TxOut era'
-> Getting
     (Either Addr CompactAddr) (TxOut era') (Either Addr CompactAddr)
-> Either Addr CompactAddr
forall s a. s -> Getting a s a -> a
^. Getting
  (Either Addr CompactAddr) (TxOut era') (Either Addr CompactAddr)
forall era.
EraTxOut era =>
Lens' (TxOut era) (Either Addr CompactAddr)
Lens' (TxOut era') (Either Addr CompactAddr)
SL.addrEitherTxOutL of
          Left Addr
addr -> Addr
addr Addr -> Set Addr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Addr
addrs
          Right CompactAddr
cAddr -> CompactAddr
cAddr CompactAddr -> Set CompactAddr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CompactAddr
compactAddrSet
     in
      TxOut era' -> Bool
checkAddr

answerShelleyTraversingQueries ::
  forall proto era m result blk.
  ( ShelleyCompatible proto era
  , Ord (TxIn (LedgerState blk))
  , Eq (TxOut (LedgerState blk))
  , MemPack (TxIn (LedgerState blk))
  , IndexedMemPack (LedgerState blk EmptyMK) (TxOut (LedgerState blk))
  ) =>
  Monad m =>
  -- | Eject TxOut
  (TxOut (LedgerState blk) -> LC.TxOut era) ->
  -- | Eject TxIn
  (TxIn (LedgerState blk) -> SL.TxIn) ->
  -- | Get filter by query
  ( forall result'.
    BlockQuery (ShelleyBlock proto era) QFTraverseTables result' ->
    TxOut (LedgerState blk) ->
    Bool
  ) ->
  ExtLedgerCfg (ShelleyBlock proto era) ->
  BlockQuery (ShelleyBlock proto era) QFTraverseTables result ->
  ReadOnlyForker' m blk ->
  m result
answerShelleyTraversingQueries :: forall proto era (m :: * -> *) result blk.
(ShelleyCompatible proto era, Ord (TxIn (LedgerState blk)),
 Eq (TxOut (LedgerState blk)), MemPack (TxIn (LedgerState blk)),
 IndexedMemPack (LedgerState blk EmptyMK) (TxOut (LedgerState blk)),
 Monad m) =>
(TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> (forall result'.
    BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
    -> TxOut (LedgerState blk) -> Bool)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> ReadOnlyForker' m blk
-> m result
answerShelleyTraversingQueries TxOut (LedgerState blk) -> TxOut era
ejTxOut TxIn (LedgerState blk) -> TxIn
ejTxIn forall result'.
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
-> TxOut (LedgerState blk) -> Bool
filt ExtLedgerCfg (ShelleyBlock proto era)
cfg BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q ReadOnlyForker' m blk
forker = case BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q of
  GetUTxOByAddress{} -> (TxOut (LedgerState blk) -> Bool)
-> RangeQueryPrevious (ExtLedgerState blk)
-> UTxO era
-> m (UTxO era)
loop (BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> TxOut (LedgerState blk) -> Bool
forall result'.
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
-> TxOut (LedgerState blk) -> Bool
filt BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q) RangeQueryPrevious (ExtLedgerState blk)
forall (l :: LedgerStateKind). RangeQueryPrevious l
NoPreviousQuery UTxO era
forall {era}. UTxO era
emptyUtxo
  BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
R:BlockQueryShelleyBlockfpresult proto era 'QFTraverseTables result
GetUTxOWhole -> (TxOut (LedgerState blk) -> Bool)
-> RangeQueryPrevious (ExtLedgerState blk)
-> UTxO era
-> m (UTxO era)
loop (BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> TxOut (LedgerState blk) -> Bool
forall result'.
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
-> TxOut (LedgerState blk) -> Bool
filt BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q) RangeQueryPrevious (ExtLedgerState blk)
forall (l :: LedgerStateKind). RangeQueryPrevious l
NoPreviousQuery UTxO era
forall {era}. UTxO era
emptyUtxo
  GetCBOR BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q' ->
    -- We encode using the latest (@maxBound@) ShelleyNodeToClientVersion,
    -- as the @GetCBOR@ query already is about opportunistically assuming
    -- both client and server are running the same version; cf. the
    -- @GetCBOR@ Haddocks.
    (result -> Encoding) -> result -> Serialised result
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> result
-> Encoding
forall proto era (fp :: QueryFootprint) result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) fp result
-> result
-> Encoding
encodeShelleyResult ShelleyNodeToClientVersion
forall a. Bounded a => a
maxBound BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q')
      (result -> result) -> m result -> m result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> (forall result'.
    BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
    -> TxOut (LedgerState blk) -> Bool)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> ReadOnlyForker' m blk
-> m result
forall proto era (m :: * -> *) result blk.
(ShelleyCompatible proto era, Ord (TxIn (LedgerState blk)),
 Eq (TxOut (LedgerState blk)), MemPack (TxIn (LedgerState blk)),
 IndexedMemPack (LedgerState blk EmptyMK) (TxOut (LedgerState blk)),
 Monad m) =>
(TxOut (LedgerState blk) -> TxOut era)
-> (TxIn (LedgerState blk) -> TxIn)
-> (forall result'.
    BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
    -> TxOut (LedgerState blk) -> Bool)
-> ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
-> ReadOnlyForker' m blk
-> m result
answerShelleyTraversingQueries TxOut (LedgerState blk) -> TxOut era
ejTxOut TxIn (LedgerState blk) -> TxIn
ejTxIn BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
-> TxOut (LedgerState blk) -> Bool
forall result'.
BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result'
-> TxOut (LedgerState blk) -> Bool
filt ExtLedgerCfg (ShelleyBlock proto era)
cfg BlockQuery (ShelleyBlock proto era) 'QFTraverseTables result
q' ReadOnlyForker' m blk
forker
 where
  emptyUtxo :: UTxO era
emptyUtxo = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
SL.UTxO Map TxIn (TxOut era)
forall k a. Map k a
Map.empty

  combUtxo :: UTxO era -> Map TxIn (TxOut era) -> UTxO era
combUtxo (SL.UTxO Map TxIn (TxOut era)
l) Map TxIn (TxOut era)
vs = Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
SL.UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era)
-> Map TxIn (TxOut era) -> Map TxIn (TxOut era)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map TxIn (TxOut era)
l Map TxIn (TxOut era)
vs

  partial ::
    (TxOut (LedgerState blk) -> Bool) ->
    LedgerTables (ExtLedgerState blk) ValuesMK ->
    Map SL.TxIn (LC.TxOut era)
  partial :: (TxOut (LedgerState blk) -> Bool)
-> LedgerTables (ExtLedgerState blk) ValuesMK
-> Map TxIn (TxOut era)
partial TxOut (LedgerState blk) -> Bool
queryPredicate (LedgerTables (ValuesMK Map (TxIn (ExtLedgerState blk)) (TxOut (ExtLedgerState blk))
vs)) =
    (TxIn (LedgerState blk) -> TxIn)
-> Map (TxIn (LedgerState blk)) (TxOut era) -> Map TxIn (TxOut era)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys TxIn (LedgerState blk) -> TxIn
ejTxIn (Map (TxIn (LedgerState blk)) (TxOut era) -> Map TxIn (TxOut era))
-> Map (TxIn (LedgerState blk)) (TxOut era) -> Map TxIn (TxOut era)
forall a b. (a -> b) -> a -> b
$
      (TxIn (LedgerState blk)
 -> TxOut (LedgerState blk) -> Maybe (TxOut era))
-> Map (TxIn (LedgerState blk)) (TxOut (LedgerState blk))
-> Map (TxIn (LedgerState blk)) (TxOut era)
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey
        ( \TxIn (LedgerState blk)
_k TxOut (LedgerState blk)
v ->
            if TxOut (LedgerState blk) -> Bool
queryPredicate TxOut (LedgerState blk)
v
              then TxOut era -> Maybe (TxOut era)
forall a. a -> Maybe a
Just (TxOut era -> Maybe (TxOut era)) -> TxOut era -> Maybe (TxOut era)
forall a b. (a -> b) -> a -> b
$ TxOut (LedgerState blk) -> TxOut era
ejTxOut TxOut (LedgerState blk)
v
              else Maybe (TxOut era)
forall a. Maybe a
Nothing
        )
        Map (TxIn (LedgerState blk)) (TxOut (LedgerState blk))
Map (TxIn (ExtLedgerState blk)) (TxOut (ExtLedgerState blk))
vs

  vnull :: ValuesMK k v -> Bool
  vnull :: forall k v. ValuesMK k v -> Bool
vnull (ValuesMK Map k v
vs) = Map k v -> Bool
forall k a. Map k a -> Bool
Map.null Map k v
vs

  toMaxKey :: LedgerTables l ValuesMK -> TxIn l
toMaxKey (LedgerTables (ValuesMK Map (TxIn l) (TxOut l)
vs)) = (TxIn l, TxOut l) -> TxIn l
forall a b. (a, b) -> a
fst ((TxIn l, TxOut l) -> TxIn l) -> (TxIn l, TxOut l) -> TxIn l
forall a b. (a -> b) -> a -> b
$ Map (TxIn l) (TxOut l) -> (TxIn l, TxOut l)
forall k a. Map k a -> (k, a)
Map.findMax Map (TxIn l) (TxOut l)
vs

  loop :: (TxOut (LedgerState blk) -> Bool)
-> RangeQueryPrevious (ExtLedgerState blk)
-> UTxO era
-> m (UTxO era)
loop TxOut (LedgerState blk) -> Bool
queryPredicate !RangeQueryPrevious (ExtLedgerState blk)
prev !UTxO era
acc = do
    extValues <- ReadOnlyForker' m blk
-> RangeQueryPrevious (ExtLedgerState blk)
-> m (LedgerTables (ExtLedgerState blk) ValuesMK)
forall (m :: * -> *) (l :: LedgerStateKind) blk.
ReadOnlyForker m l blk
-> RangeQueryPrevious l -> m (LedgerTables l ValuesMK)
LedgerDB.roforkerRangeReadTables ReadOnlyForker' m blk
forker RangeQueryPrevious (ExtLedgerState blk)
prev
    if ltcollapse $ ltmap (K2 . vnull) extValues
      then pure acc
      else
        loop
          queryPredicate
          (PreviousQueryWasUpTo $ toMaxKey extValues)
          (combUtxo acc $ partial queryPredicate extValues)