{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DisambiguateRecordFields   #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Shelley.Ledger.Query (
    BlockQuery (.., GetUTxO, GetFilteredUTxO)
  , NonMyopicMemberRewards (..)
  , querySupportedVersion
    -- * Serialisation
  , decodeShelleyQuery
  , decodeShelleyResult
  , encodeShelleyQuery
  , encodeShelleyResult
  ) where

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 (Serialise, decode, encode)
import           Data.Kind (Type)
import           Data.Map.Strict (Map)
import           Data.Set (Set)
import           Data.Type.Equality (apply)
import           Data.Typeable (Typeable)
import           Data.UMap (View (..), domRestrictedView)

import           Cardano.Binary (FromCBOR (..), ToCBOR (..))

import           Ouroboros.Network.Block (Serialised (..), decodePoint,
                     encodePoint, mkSerialised)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Util (ShowProxy (..))

import qualified Cardano.Ledger.Core as LC
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.LedgerState as SL (RewardAccounts)
import qualified Cardano.Ledger.Shelley.RewardProvenance as SL
                     (RewardProvenance)

import           Cardano.Ledger.Crypto (Crypto)
import           Ouroboros.Consensus.Protocol.Abstract (ChainDepState)
import           Ouroboros.Consensus.Shelley.Eras (EraCrypto)
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 (..))

{-------------------------------------------------------------------------------
  QueryLedger
-------------------------------------------------------------------------------}

newtype NonMyopicMemberRewards c = NonMyopicMemberRewards {
      NonMyopicMemberRewards c
-> Map
     (Either Coin (Credential 'Staking c))
     (Map (KeyHash 'StakePool c) Coin)
unNonMyopicMemberRewards ::
        Map (Either SL.Coin (SL.Credential 'SL.Staking c))
            (Map (SL.KeyHash 'SL.StakePool c) SL.Coin)
    }
  deriving stock   (Int -> NonMyopicMemberRewards c -> ShowS
[NonMyopicMemberRewards c] -> ShowS
NonMyopicMemberRewards c -> String
(Int -> NonMyopicMemberRewards c -> ShowS)
-> (NonMyopicMemberRewards c -> String)
-> ([NonMyopicMemberRewards c] -> ShowS)
-> Show (NonMyopicMemberRewards c)
forall c. Int -> NonMyopicMemberRewards c -> ShowS
forall c. [NonMyopicMemberRewards c] -> ShowS
forall c. NonMyopicMemberRewards c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonMyopicMemberRewards c] -> ShowS
$cshowList :: forall c. [NonMyopicMemberRewards c] -> ShowS
show :: NonMyopicMemberRewards c -> String
$cshow :: forall c. NonMyopicMemberRewards c -> String
showsPrec :: Int -> NonMyopicMemberRewards c -> ShowS
$cshowsPrec :: forall c. Int -> NonMyopicMemberRewards c -> ShowS
Show)
  deriving newtype (NonMyopicMemberRewards c -> NonMyopicMemberRewards c -> Bool
(NonMyopicMemberRewards c -> NonMyopicMemberRewards c -> Bool)
-> (NonMyopicMemberRewards c -> NonMyopicMemberRewards c -> Bool)
-> Eq (NonMyopicMemberRewards c)
forall c.
NonMyopicMemberRewards c -> NonMyopicMemberRewards c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonMyopicMemberRewards c -> NonMyopicMemberRewards c -> Bool
$c/= :: forall c.
NonMyopicMemberRewards c -> NonMyopicMemberRewards c -> Bool
== :: NonMyopicMemberRewards c -> NonMyopicMemberRewards c -> Bool
$c== :: forall c.
NonMyopicMemberRewards c -> NonMyopicMemberRewards c -> Bool
Eq)

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

instance Crypto c => Serialise (NonMyopicMemberRewards c) where
  encode :: NonMyopicMemberRewards c -> Encoding
encode = Map
  (Either Coin (Credential 'Staking c))
  (Map (KeyHash 'StakePool c) Coin)
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Map
   (Either Coin (Credential 'Staking c))
   (Map (KeyHash 'StakePool c) Coin)
 -> Encoding)
-> (NonMyopicMemberRewards c
    -> Map
         (Either Coin (Credential 'Staking c))
         (Map (KeyHash 'StakePool c) Coin))
-> NonMyopicMemberRewards c
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonMyopicMemberRewards c
-> Map
     (Either Coin (Credential 'Staking c))
     (Map (KeyHash 'StakePool c) Coin)
forall c.
NonMyopicMemberRewards c
-> Map
     (Either Coin (Credential 'Staking c))
     (Map (KeyHash 'StakePool c) Coin)
unNonMyopicMemberRewards
  decode :: Decoder s (NonMyopicMemberRewards c)
decode = Map
  (Either Coin (Credential 'Staking c))
  (Map (KeyHash 'StakePool c) Coin)
-> NonMyopicMemberRewards c
forall c.
Map
  (Either Coin (Credential 'Staking c))
  (Map (KeyHash 'StakePool c) Coin)
-> NonMyopicMemberRewards c
NonMyopicMemberRewards (Map
   (Either Coin (Credential 'Staking c))
   (Map (KeyHash 'StakePool c) Coin)
 -> NonMyopicMemberRewards c)
-> Decoder
     s
     (Map
        (Either Coin (Credential 'Staking c))
        (Map (KeyHash 'StakePool c) Coin))
-> Decoder s (NonMyopicMemberRewards c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder
  s
  (Map
     (Either Coin (Credential 'Staking c))
     (Map (KeyHash 'StakePool c) Coin))
forall a s. FromCBOR a => Decoder s a
fromCBOR

data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where
  GetLedgerTip :: BlockQuery (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
  GetEpochNo :: BlockQuery (ShelleyBlock proto era) 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 (EraCrypto era)))
    -> BlockQuery (ShelleyBlock proto era) (NonMyopicMemberRewards (EraCrypto era))
  GetCurrentPParams
    :: BlockQuery (ShelleyBlock proto era) (LC.PParams era)
  GetProposedPParamsUpdates
    :: BlockQuery (ShelleyBlock proto era) (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) (SL.PoolDistr (EraCrypto era))

  -- | 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 (EraCrypto era))
    -> BlockQuery (ShelleyBlock proto era) (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) (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) (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) result
    -> BlockQuery (ShelleyBlock proto era) (Serialised result)

  GetFilteredDelegationsAndRewardAccounts
    :: Set (SL.Credential 'SL.Staking (EraCrypto era))
    -> BlockQuery (ShelleyBlock proto era)
             (Delegations (EraCrypto era), SL.RewardAccounts (EraCrypto era))

  GetGenesisConfig
    :: BlockQuery (ShelleyBlock proto era) (CompactGenesis era)

  -- | 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) (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) (ChainDepState proto)

  GetRewardProvenance
    :: BlockQuery (ShelleyBlock proto era) (SL.RewardProvenance (EraCrypto era))

  -- | 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 (EraCrypto era))
    -> BlockQuery (ShelleyBlock proto era) (SL.UTxO era)

  GetStakePools
    :: BlockQuery (ShelleyBlock proto era)
                  (Set (SL.KeyHash 'SL.StakePool (EraCrypto era)))

  GetStakePoolParams
    :: Set (SL.KeyHash 'SL.StakePool (EraCrypto era))
    -> BlockQuery (ShelleyBlock proto era)
                  (Map (SL.KeyHash 'SL.StakePool (EraCrypto era))
                       (SL.PoolParams (EraCrypto era)))

  GetRewardInfoPools
    :: BlockQuery (ShelleyBlock proto era)
                  (SL.RewardParams,
                    Map (SL.KeyHash 'SL.StakePool (EraCrypto era))
                        (SL.RewardInfoPool))

  -- 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.

pattern GetUTxO :: BlockQuery (ShelleyBlock proto era) (SL.UTxO era)
pattern $bGetUTxO :: BlockQuery (ShelleyBlock proto era) (UTxO era)
$mGetUTxO :: forall r proto era.
BlockQuery (ShelleyBlock proto era) (UTxO era)
-> (Void# -> r) -> (Void# -> r) -> r
GetUTxO = GetUTxOWhole
{-# DEPRECATED GetUTxO "Use 'GetUTxOWhole'" #-}

pattern GetFilteredUTxO :: Set (SL.Addr (EraCrypto era))
                        -> BlockQuery (ShelleyBlock proto era) (SL.UTxO era)
pattern $bGetFilteredUTxO :: Set (Addr (EraCrypto era))
-> BlockQuery (ShelleyBlock proto era) (UTxO era)
$mGetFilteredUTxO :: forall r era proto.
BlockQuery (ShelleyBlock proto era) (UTxO era)
-> (Set (Addr (EraCrypto era)) -> r) -> (Void# -> r) -> r
GetFilteredUTxO x = GetUTxOByAddress x
{-# DEPRECATED GetFilteredUTxO "Use 'GetUTxOByAddress'" #-}


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

instance ShelleyCompatible proto era => QueryLedger (ShelleyBlock proto era) where
  answerBlockQuery :: ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) result
-> ExtLedgerState (ShelleyBlock proto era)
-> result
answerBlockQuery ExtLedgerCfg (ShelleyBlock proto era)
cfg BlockQuery (ShelleyBlock proto era) result
query ExtLedgerState (ShelleyBlock proto era)
ext =
      case BlockQuery (ShelleyBlock proto era) result
query of
        BlockQuery (ShelleyBlock proto era) result
GetLedgerTip ->
          LedgerState (ShelleyBlock proto era)
-> Point (ShelleyBlock proto era)
forall proto era.
LedgerState (ShelleyBlock proto era)
-> Point (ShelleyBlock proto era)
shelleyLedgerTipPoint LedgerState (ShelleyBlock proto era)
lst
        BlockQuery (ShelleyBlock proto era) result
GetEpochNo ->
          NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
SL.nesEL NewEpochState era
st
        GetNonMyopicMemberRewards creds ->
          Map
  (Either Coin (Credential 'Staking (ProtoCrypto proto)))
  (Map (KeyHash 'StakePool (ProtoCrypto proto)) Coin)
-> NonMyopicMemberRewards (ProtoCrypto proto)
forall c.
Map
  (Either Coin (Credential 'Staking c))
  (Map (KeyHash 'StakePool c) Coin)
-> NonMyopicMemberRewards c
NonMyopicMemberRewards (Map
   (Either Coin (Credential 'Staking (ProtoCrypto proto)))
   (Map (KeyHash 'StakePool (ProtoCrypto proto)) Coin)
 -> NonMyopicMemberRewards (ProtoCrypto proto))
-> Map
     (Either Coin (Credential 'Staking (ProtoCrypto proto)))
     (Map (KeyHash 'StakePool (ProtoCrypto proto)) Coin)
-> NonMyopicMemberRewards (ProtoCrypto proto)
forall a b. (a -> b) -> a -> b
$
            Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking (Crypto era)))
-> Map
     (Either Coin (Credential 'Staking (Crypto era)))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
forall era.
(HasField "_a0" (PParams era) NonNegativeInterval,
 HasField "_nOpt" (PParams era) Natural) =>
Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking (Crypto era)))
-> Map
     (Either Coin (Credential 'Staking (Crypto era)))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
SL.getNonMyopicMemberRewards Globals
globals NewEpochState era
st Set (Either Coin (Credential 'Staking (Crypto era)))
creds
        BlockQuery (ShelleyBlock proto era) result
GetCurrentPParams ->
          NewEpochState era -> PParams era
forall era. NewEpochState era -> PParams era
getPParams NewEpochState era
st
        BlockQuery (ShelleyBlock proto era) result
GetProposedPParamsUpdates ->
          NewEpochState era -> ProposedPPUpdates era
forall era.
ShelleyBasedEra era =>
NewEpochState era -> ProposedPPUpdates era
getProposedPPUpdates NewEpochState era
st
        BlockQuery (ShelleyBlock proto era) result
GetStakeDistribution ->
          Globals -> NewEpochState era -> PoolDistr (Crypto era)
forall era. Globals -> NewEpochState era -> PoolDistr (Crypto era)
SL.poolsByTotalStakeFraction Globals
globals NewEpochState era
st
        GetUTxOByAddress addrs ->
          NewEpochState era -> Set (Addr (Crypto era)) -> UTxO era
forall era.
Era era =>
NewEpochState era -> Set (Addr (Crypto era)) -> UTxO era
SL.getFilteredUTxO NewEpochState era
st Set (Addr (Crypto era))
addrs
        BlockQuery (ShelleyBlock proto era) result
GetUTxOWhole ->
          NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
SL.getUTxO NewEpochState era
st
        BlockQuery (ShelleyBlock proto era) result
DebugEpochState ->
          NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
getEpochState NewEpochState era
st
        GetCBOR query' ->
          (result -> Encoding) -> result -> Serialised result
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
forall proto era result.
ShelleyCompatible proto era =>
BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
encodeShelleyResult BlockQuery (ShelleyBlock proto era) result
query') (result -> Serialised result) -> result -> Serialised result
forall a b. (a -> b) -> a -> b
$
            ExtLedgerCfg (ShelleyBlock proto era)
-> BlockQuery (ShelleyBlock proto era) result
-> ExtLedgerState (ShelleyBlock proto era)
-> result
forall blk result.
QueryLedger blk =>
ExtLedgerCfg blk
-> BlockQuery blk result -> ExtLedgerState blk -> result
answerBlockQuery ExtLedgerCfg (ShelleyBlock proto era)
cfg BlockQuery (ShelleyBlock proto era) result
query' ExtLedgerState (ShelleyBlock proto era)
ext
        GetFilteredDelegationsAndRewardAccounts creds ->
          NewEpochState era
-> Set (Credential 'Staking (Crypto era))
-> (Delegations (Crypto era), RewardAccounts (Crypto era))
forall era.
NewEpochState era
-> Set (Credential 'Staking (EraCrypto era))
-> (Delegations (EraCrypto era), RewardAccounts (EraCrypto era))
getFilteredDelegationsAndRewardAccounts NewEpochState era
st Set (Credential 'Staking (Crypto era))
creds
        BlockQuery (ShelleyBlock proto era) result
GetGenesisConfig ->
          ShelleyLedgerConfig era -> CompactGenesis era
forall era. ShelleyLedgerConfig era -> CompactGenesis era
shelleyLedgerCompactGenesis LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
lcfg
        BlockQuery (ShelleyBlock proto era) result
DebugNewEpochState ->
          result
NewEpochState era
st
        BlockQuery (ShelleyBlock proto era) 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) result
GetRewardProvenance ->
          (RewardUpdate (ProtoCrypto proto), result) -> result
forall a b. (a, b) -> b
snd ((RewardUpdate (ProtoCrypto proto), result) -> result)
-> (RewardUpdate (ProtoCrypto proto), result) -> result
forall a b. (a -> b) -> a -> b
$ Globals
-> NewEpochState era
-> (RewardUpdate (Crypto era), RewardProvenance (Crypto era))
forall era.
(HasField "_a0" (PParams era) NonNegativeInterval,
 HasField "_d" (PParams era) UnitInterval,
 HasField "_nOpt" (PParams era) Natural,
 HasField "_protocolVersion" (PParams era) ProtVer,
 HasField "_rho" (PParams era) UnitInterval,
 HasField "_tau" (PParams era) UnitInterval) =>
Globals
-> NewEpochState era
-> (RewardUpdate (Crypto era), RewardProvenance (Crypto era))
SL.getRewardProvenance Globals
globals NewEpochState era
st
        GetUTxOByTxIn txins ->
          NewEpochState era -> Set (TxIn (Crypto era)) -> UTxO era
forall era.
NewEpochState era -> Set (TxIn (Crypto era)) -> UTxO era
SL.getUTxOSubset NewEpochState era
st Set (TxIn (Crypto era))
txins
        BlockQuery (ShelleyBlock proto era) result
GetStakePools ->
          NewEpochState era -> Set (KeyHash 'StakePool (Crypto era))
forall era.
NewEpochState era -> Set (KeyHash 'StakePool (Crypto era))
SL.getPools NewEpochState era
st
        GetStakePoolParams poolids ->
          NewEpochState era
-> Set (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
forall era.
NewEpochState era
-> Set (KeyHash 'StakePool (Crypto era))
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
SL.getPoolParameters NewEpochState era
st Set (KeyHash 'StakePool (Crypto era))
poolids
        BlockQuery (ShelleyBlock proto era) result
GetRewardInfoPools ->
          Globals
-> NewEpochState era
-> (RewardParams,
    Map (KeyHash 'StakePool (Crypto era)) RewardInfoPool)
forall era.
(HasField "_a0" (PParams era) NonNegativeInterval,
 HasField "_nOpt" (PParams era) Natural) =>
Globals
-> NewEpochState era
-> (RewardParams,
    Map (KeyHash 'StakePool (Crypto era)) RewardInfoPool)
SL.getRewardInfoPools Globals
globals NewEpochState era
st
    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)
lst = ExtLedgerState (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era)
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState ExtLedgerState (ShelleyBlock proto era)
ext
      hst :: HeaderState (ShelleyBlock proto era)
hst = ExtLedgerState (ShelleyBlock proto era)
-> HeaderState (ShelleyBlock proto era)
forall blk. ExtLedgerState blk -> HeaderState blk
headerState ExtLedgerState (ShelleyBlock proto era)
ext
      st :: NewEpochState era
st  = LedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
shelleyLedgerState LedgerState (ShelleyBlock proto era)
lst

instance SameDepIndex (BlockQuery (ShelleyBlock proto era)) where
  sameDepIndex :: BlockQuery (ShelleyBlock proto era) a
-> BlockQuery (ShelleyBlock proto era) b -> Maybe (a :~: b)
sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetLedgerTip BlockQuery (ShelleyBlock proto era) b
GetLedgerTip
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetLedgerTip BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetEpochNo BlockQuery (ShelleyBlock proto era) b
GetEpochNo
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetEpochNo BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetNonMyopicMemberRewards creds) (GetNonMyopicMemberRewards creds')
    | Set (Either Coin (Credential 'Staking (EraCrypto era)))
creds Set (Either Coin (Credential 'Staking (EraCrypto era)))
-> Set (Either Coin (Credential 'Staking (EraCrypto era))) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Either Coin (Credential 'Staking (EraCrypto era)))
creds'
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    | Bool
otherwise
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetNonMyopicMemberRewards _) BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetCurrentPParams BlockQuery (ShelleyBlock proto era) b
GetCurrentPParams
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetCurrentPParams BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetProposedPParamsUpdates BlockQuery (ShelleyBlock proto era) b
GetProposedPParamsUpdates
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetProposedPParamsUpdates BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetStakeDistribution BlockQuery (ShelleyBlock proto era) b
GetStakeDistribution
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetStakeDistribution BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetUTxOByAddress addrs) (GetUTxOByAddress addrs')
    | Set (Addr (EraCrypto era))
addrs Set (Addr (EraCrypto era)) -> Set (Addr (EraCrypto era)) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Addr (EraCrypto era))
addrs'
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    | Bool
otherwise
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetUTxOByAddress _) BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetUTxOWhole BlockQuery (ShelleyBlock proto era) b
GetUTxOWhole
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetUTxOWhole BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
DebugEpochState BlockQuery (ShelleyBlock proto era) b
DebugEpochState
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
DebugEpochState BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetCBOR q) (GetCBOR q')
    = (Serialised :~: Serialised)
-> (result :~: result) -> Serialised result :~: Serialised result
forall k1 k2 (f :: k1 -> k2) (g :: k1 -> k2) (a :: k1) (b :: k1).
(f :~: g) -> (a :~: b) -> f a :~: g b
apply Serialised :~: Serialised
forall k (a :: k). a :~: a
Refl ((result :~: result) -> Serialised result :~: Serialised result)
-> Maybe (result :~: result)
-> Maybe (Serialised result :~: Serialised result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockQuery (ShelleyBlock proto era) result
-> BlockQuery (ShelleyBlock proto era) result
-> Maybe (result :~: result)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex BlockQuery (ShelleyBlock proto era) result
q BlockQuery (ShelleyBlock proto era) result
q'
  sameDepIndex (GetCBOR _) BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetFilteredDelegationsAndRewardAccounts creds)
               (GetFilteredDelegationsAndRewardAccounts creds')
    | Set (Credential 'Staking (EraCrypto era))
creds Set (Credential 'Staking (EraCrypto era))
-> Set (Credential 'Staking (EraCrypto era)) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Credential 'Staking (EraCrypto era))
creds'
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    | Bool
otherwise
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetFilteredDelegationsAndRewardAccounts _) BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetGenesisConfig BlockQuery (ShelleyBlock proto era) b
GetGenesisConfig
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetGenesisConfig BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
DebugNewEpochState BlockQuery (ShelleyBlock proto era) b
DebugNewEpochState
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
DebugNewEpochState BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
DebugChainDepState BlockQuery (ShelleyBlock proto era) b
DebugChainDepState
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
DebugChainDepState BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetRewardProvenance BlockQuery (ShelleyBlock proto era) b
GetRewardProvenance
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetRewardProvenance BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetUTxOByTxIn addrs) (GetUTxOByTxIn addrs')
    | Set (TxIn (EraCrypto era))
addrs Set (TxIn (EraCrypto era)) -> Set (TxIn (EraCrypto era)) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (TxIn (EraCrypto era))
addrs'
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    | Bool
otherwise
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetUTxOByTxIn _) BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetStakePools BlockQuery (ShelleyBlock proto era) b
GetStakePools
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetStakePools BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetStakePoolParams poolids) (GetStakePoolParams poolids')
    | Set (KeyHash 'StakePool (EraCrypto era))
poolids Set (KeyHash 'StakePool (EraCrypto era))
-> Set (KeyHash 'StakePool (EraCrypto era)) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (KeyHash 'StakePool (EraCrypto era))
poolids'
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    | Bool
otherwise
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetStakePoolParams _) BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetRewardInfoPools BlockQuery (ShelleyBlock proto era) b
GetRewardInfoPools
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex BlockQuery (ShelleyBlock proto era) a
GetRewardInfoPools BlockQuery (ShelleyBlock proto era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing

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

instance ShelleyCompatible proto era => ShowQuery (BlockQuery (ShelleyBlock proto era)) where
  showResult :: BlockQuery (ShelleyBlock proto era) result -> result -> String
showResult = \case
      BlockQuery (ShelleyBlock proto era) result
GetLedgerTip                               -> result -> String
forall a. Show a => a -> String
show
      BlockQuery (ShelleyBlock proto era) 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) result
GetCurrentPParams                          -> result -> String
forall a. Show a => a -> String
show
      BlockQuery (ShelleyBlock proto era) result
GetProposedPParamsUpdates                  -> result -> String
forall a. Show a => a -> String
show
      BlockQuery (ShelleyBlock proto era) 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) result
GetUTxOWhole                               -> result -> String
forall a. Show a => a -> String
show
      BlockQuery (ShelleyBlock proto era) 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) result
GetGenesisConfig                           -> result -> String
forall a. Show a => a -> String
show
      BlockQuery (ShelleyBlock proto era) result
DebugNewEpochState                         -> result -> String
forall a. Show a => a -> String
show
      BlockQuery (ShelleyBlock proto era) result
DebugChainDepState                         -> result -> String
forall a. Show a => a -> String
show
      BlockQuery (ShelleyBlock proto era) 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) 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) result
GetRewardInfoPools                         -> result -> String
forall a. Show a => a -> String
show

-- | Is the given query supported by the given 'ShelleyNodeToClientVersion'?
querySupportedVersion :: BlockQuery (ShelleyBlock proto era) result -> ShelleyNodeToClientVersion -> Bool
querySupportedVersion :: BlockQuery (ShelleyBlock proto era) result
-> ShelleyNodeToClientVersion -> Bool
querySupportedVersion = \case
    BlockQuery (ShelleyBlock proto era) result
GetLedgerTip                               -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    BlockQuery (ShelleyBlock proto era) result
GetEpochNo                                 -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    GetNonMyopicMemberRewards {}               -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    BlockQuery (ShelleyBlock proto era) result
GetCurrentPParams                          -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    BlockQuery (ShelleyBlock proto era) result
GetProposedPParamsUpdates                  -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    BlockQuery (ShelleyBlock proto era) result
GetStakeDistribution                       -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    GetUTxOByAddress {}                        -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    BlockQuery (ShelleyBlock proto era) result
GetUTxOWhole                               -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    BlockQuery (ShelleyBlock proto era) result
DebugEpochState                            -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    GetCBOR q                                  -> BlockQuery (ShelleyBlock proto era) result
-> ShelleyNodeToClientVersion -> Bool
forall proto era result.
BlockQuery (ShelleyBlock proto era) result
-> ShelleyNodeToClientVersion -> Bool
querySupportedVersion BlockQuery (ShelleyBlock proto era) result
q
    GetFilteredDelegationsAndRewardAccounts {} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    BlockQuery (ShelleyBlock proto era) result
GetGenesisConfig                           -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v2)
    BlockQuery (ShelleyBlock proto era) result
DebugNewEpochState                         -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v2)
    BlockQuery (ShelleyBlock proto era) result
DebugChainDepState                         -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v2)
    BlockQuery (ShelleyBlock proto era) result
GetRewardProvenance                        -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v3)
    GetUTxOByTxIn {}                           -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v4)
    BlockQuery (ShelleyBlock proto era) result
GetStakePools                              -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v4)
    GetStakePoolParams {}                      -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v4)
    BlockQuery (ShelleyBlock proto era) result
GetRewardInfoPools                         -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v5)
    -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@
    -- must be added. See #2830 for a template on how to do this.
  where
    v1 :: ShelleyNodeToClientVersion
v1 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion1
    v2 :: ShelleyNodeToClientVersion
v2 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion2
    v3 :: ShelleyNodeToClientVersion
v3 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion3
    v4 :: ShelleyNodeToClientVersion
v4 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion4
    v5 :: ShelleyNodeToClientVersion
v5 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion5

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

getProposedPPUpdates ::
     ShelleyBasedEra era
  => SL.NewEpochState era -> SL.ProposedPPUpdates era
getProposedPPUpdates :: NewEpochState era -> ProposedPPUpdates era
getProposedPPUpdates = PPUPState era -> ProposedPPUpdates era
forall era. PPUPState era -> ProposedPPUpdates era
SL.proposals (PPUPState era -> ProposedPPUpdates era)
-> (NewEpochState era -> PPUPState era)
-> NewEpochState era
-> ProposedPPUpdates era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOState era -> PPUPState era
forall era. UTxOState era -> State (EraRule "PPUP" era)
SL._ppups
                     (UTxOState era -> PPUPState era)
-> (NewEpochState era -> UTxOState era)
-> NewEpochState era
-> PPUPState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
SL.lsUTxOState (LedgerState era -> UTxOState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> UTxOState 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

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

getDState :: SL.NewEpochState era -> SL.DState (EraCrypto era)
getDState :: NewEpochState era -> DState (EraCrypto era)
getDState = DPState (EraCrypto era) -> DState (EraCrypto era)
forall crypto. DPState crypto -> DState crypto
SL.dpsDState (DPState (EraCrypto era) -> DState (EraCrypto era))
-> (NewEpochState era -> DPState (EraCrypto era))
-> NewEpochState era
-> DState (EraCrypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState (EraCrypto era)
forall era. LedgerState era -> DPState (Crypto era)
SL.lsDPState (LedgerState era -> DPState (EraCrypto era))
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> DPState (EraCrypto 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.NewEpochState era
  -> Set (SL.Credential 'SL.Staking (EraCrypto era))
  -> (Delegations (EraCrypto era), SL.RewardAccounts (EraCrypto era))
getFilteredDelegationsAndRewardAccounts :: NewEpochState era
-> Set (Credential 'Staking (EraCrypto era))
-> (Delegations (EraCrypto era), RewardAccounts (EraCrypto era))
getFilteredDelegationsAndRewardAccounts NewEpochState era
ss Set (Credential 'Staking (EraCrypto era))
creds =
    (Delegations (EraCrypto era)
filteredDelegations, RewardAccounts (EraCrypto era)
filteredRwdAcnts)
  where
    u :: UnifiedMap (EraCrypto era)
u = DState (EraCrypto era) -> UnifiedMap (EraCrypto era)
forall crypto. DState crypto -> UnifiedMap crypto
SL._unified (DState (EraCrypto era) -> UnifiedMap (EraCrypto era))
-> DState (EraCrypto era) -> UnifiedMap (EraCrypto era)
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> DState (EraCrypto era)
forall era. NewEpochState era -> DState (EraCrypto era)
getDState NewEpochState era
ss

    filteredDelegations :: Delegations (EraCrypto era)
filteredDelegations = Set (Credential 'Staking (EraCrypto era))
-> View
     Coin
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
     Ptr
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
-> Delegations (EraCrypto era)
forall ptr cred k coin pl v.
(Ord ptr, Ord cred) =>
Set k -> View coin cred pl ptr k v -> Map k v
domRestrictedView Set (Credential 'Staking (EraCrypto era))
creds (View
   Coin
   (Credential 'Staking (EraCrypto era))
   (KeyHash 'StakePool (EraCrypto era))
   Ptr
   (Credential 'Staking (EraCrypto era))
   (KeyHash 'StakePool (EraCrypto era))
 -> Delegations (EraCrypto era))
-> View
     Coin
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
     Ptr
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
-> Delegations (EraCrypto era)
forall a b. (a -> b) -> a -> b
$ UnifiedMap (EraCrypto era)
-> View
     Coin
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
     Ptr
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr pl
Delegations UnifiedMap (EraCrypto era)
u
    filteredRwdAcnts :: RewardAccounts (EraCrypto era)
filteredRwdAcnts = Set (Credential 'Staking (EraCrypto era))
-> View
     Coin
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
     Ptr
     (Credential 'Staking (EraCrypto era))
     Coin
-> RewardAccounts (EraCrypto era)
forall ptr cred k coin pl v.
(Ord ptr, Ord cred) =>
Set k -> View coin cred pl ptr k v -> Map k v
domRestrictedView Set (Credential 'Staking (EraCrypto era))
creds (View
   Coin
   (Credential 'Staking (EraCrypto era))
   (KeyHash 'StakePool (EraCrypto era))
   Ptr
   (Credential 'Staking (EraCrypto era))
   Coin
 -> RewardAccounts (EraCrypto era))
-> View
     Coin
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
     Ptr
     (Credential 'Staking (EraCrypto era))
     Coin
-> RewardAccounts (EraCrypto era)
forall a b. (a -> b) -> a -> b
$ UnifiedMap (EraCrypto era)
-> View
     Coin
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
     Ptr
     (Credential 'Staking (EraCrypto era))
     Coin
forall coin cr pl ptr.
UMap coin cr pl ptr -> View coin cr pl ptr cr coin
Rewards UnifiedMap (EraCrypto era)
u

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

encodeShelleyQuery ::
     ShelleyBasedEra era
  => BlockQuery (ShelleyBlock proto era) result -> Encoding
encodeShelleyQuery :: BlockQuery (ShelleyBlock proto era) result -> Encoding
encodeShelleyQuery BlockQuery (ShelleyBlock proto era) result
query = case BlockQuery (ShelleyBlock proto era) result
query of
    BlockQuery (ShelleyBlock proto era) 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) 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 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 (Crypto era))) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Either Coin (Credential 'Staking (Crypto era)))
creds
    BlockQuery (ShelleyBlock proto era) 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) 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) 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 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
<> Set (Addr (Crypto era)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Addr (Crypto era))
addrs
    BlockQuery (ShelleyBlock proto era) 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) 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 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) result -> Encoding
forall era proto result.
ShelleyBasedEra era =>
BlockQuery (ShelleyBlock proto era) result -> Encoding
encodeShelleyQuery BlockQuery (ShelleyBlock proto era) result
query'
    GetFilteredDelegationsAndRewardAccounts 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
<> Set (Credential 'Staking (Crypto era)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Credential 'Staking (Crypto era))
creds
    BlockQuery (ShelleyBlock proto era) 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) 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) 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) 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 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
<> Set (TxIn (Crypto era)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (TxIn (Crypto era))
txins
    BlockQuery (ShelleyBlock proto era) 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 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 (Crypto era)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (KeyHash 'StakePool (Crypto era))
poolids
    BlockQuery (ShelleyBlock proto era) result
GetRewardInfoPools ->
      Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
18

decodeShelleyQuery ::
     ShelleyBasedEra era
  => Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
decodeShelleyQuery :: Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
decodeShelleyQuery = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case (Int
len, Word8
tag) of
      (Int
1, Word8
0)  -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
GetLedgerTip
      (Int
1, Word8
1)  -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) EpochNo
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) EpochNo
forall proto era. BlockQuery (ShelleyBlock proto era) EpochNo
GetEpochNo
      (Int
2, Word8
2)  -> BlockQuery
  (ShelleyBlock proto era) (NonMyopicMemberRewards (Crypto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (BlockQuery
   (ShelleyBlock proto era) (NonMyopicMemberRewards (Crypto era))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> (Set (Either Coin (Credential 'Staking (Crypto era)))
    -> BlockQuery
         (ShelleyBlock proto era) (NonMyopicMemberRewards (Crypto era)))
-> Set (Either Coin (Credential 'Staking (Crypto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either Coin (Credential 'Staking (Crypto era)))
-> BlockQuery
     (ShelleyBlock proto era) (NonMyopicMemberRewards (Crypto era))
forall era proto.
Set (Either Coin (Credential 'Staking (EraCrypto era)))
-> BlockQuery
     (ShelleyBlock proto era) (NonMyopicMemberRewards (EraCrypto era))
GetNonMyopicMemberRewards (Set (Either Coin (Credential 'Staking (Crypto era)))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Decoder s (Set (Either Coin (Credential 'Staking (Crypto era))))
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Either Coin (Credential 'Staking (Crypto era))))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
1, Word8
3)  -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (PParams era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (PParams era)
forall proto era. BlockQuery (ShelleyBlock proto era) (PParams era)
GetCurrentPParams
      (Int
1, Word8
4)  -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (ProposedPPUpdates era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (ProposedPPUpdates era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (ProposedPPUpdates era)
GetProposedPParamsUpdates
      (Int
1, Word8
5)  -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (PoolDistr (Crypto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (PoolDistr (Crypto era))
forall proto era.
BlockQuery (ShelleyBlock proto era) (PoolDistr (EraCrypto era))
GetStakeDistribution
      (Int
2, Word8
6)  -> BlockQuery (ShelleyBlock proto era) (UTxO era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (BlockQuery (ShelleyBlock proto era) (UTxO era)
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> (Set (Addr (Crypto era))
    -> BlockQuery (ShelleyBlock proto era) (UTxO era))
-> Set (Addr (Crypto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Addr (Crypto era))
-> BlockQuery (ShelleyBlock proto era) (UTxO era)
forall era proto.
Set (Addr (EraCrypto era))
-> BlockQuery (ShelleyBlock proto era) (UTxO era)
GetUTxOByAddress (Set (Addr (Crypto era))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Decoder s (Set (Addr (Crypto era)))
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Addr (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
1, Word8
7)  -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (UTxO era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (UTxO era)
forall proto era. BlockQuery (ShelleyBlock proto era) (UTxO era)
GetUTxOWhole
      (Int
1, Word8
8)  -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (EpochState era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (EpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (EpochState era)
DebugEpochState
      (Int
2, Word8
9)  -> (\(SomeSecond BlockQuery (ShelleyBlock proto era) b
q) -> BlockQuery (ShelleyBlock proto era) (Serialised b)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (BlockQuery (ShelleyBlock proto era) b
-> BlockQuery (ShelleyBlock proto era) (Serialised b)
forall proto era result.
BlockQuery (ShelleyBlock proto era) result
-> BlockQuery (ShelleyBlock proto era) (Serialised result)
GetCBOR BlockQuery (ShelleyBlock proto era) b
q)) (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall era s proto.
ShelleyBasedEra era =>
Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
decodeShelleyQuery
      (Int
2, Word8
10) -> BlockQuery
  (ShelleyBlock proto era)
  (Delegations (Crypto era), RewardAccounts (Crypto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (BlockQuery
   (ShelleyBlock proto era)
   (Delegations (Crypto era), RewardAccounts (Crypto era))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> (Set (Credential 'Staking (Crypto era))
    -> BlockQuery
         (ShelleyBlock proto era)
         (Delegations (Crypto era), RewardAccounts (Crypto era)))
-> Set (Credential 'Staking (Crypto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'Staking (Crypto era))
-> BlockQuery
     (ShelleyBlock proto era)
     (Delegations (Crypto era), RewardAccounts (Crypto era))
forall era proto.
Set (Credential 'Staking (EraCrypto era))
-> BlockQuery
     (ShelleyBlock proto era)
     (Delegations (EraCrypto era), RewardAccounts (EraCrypto era))
GetFilteredDelegationsAndRewardAccounts (Set (Credential 'Staking (Crypto era))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Decoder s (Set (Credential 'Staking (Crypto era)))
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Credential 'Staking (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
1, Word8
11) -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (CompactGenesis era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (CompactGenesis era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (CompactGenesis era)
GetGenesisConfig
      (Int
1, Word8
12) -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (NewEpochState era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (NewEpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (NewEpochState era)
DebugNewEpochState
      (Int
1, Word8
13) -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (ChainDepState proto)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (ChainDepState proto)
forall proto era.
BlockQuery (ShelleyBlock proto era) (ChainDepState proto)
DebugChainDepState
      (Int
1, Word8
14) -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (RewardProvenance (Crypto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (RewardProvenance (Crypto era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (RewardProvenance (EraCrypto era))
GetRewardProvenance
      (Int
2, Word8
15) -> BlockQuery (ShelleyBlock proto era) (UTxO era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (BlockQuery (ShelleyBlock proto era) (UTxO era)
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> (Set (TxIn (Crypto era))
    -> BlockQuery (ShelleyBlock proto era) (UTxO era))
-> Set (TxIn (Crypto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (TxIn (Crypto era))
-> BlockQuery (ShelleyBlock proto era) (UTxO era)
forall era proto.
Set (TxIn (EraCrypto era))
-> BlockQuery (ShelleyBlock proto era) (UTxO era)
GetUTxOByTxIn (Set (TxIn (Crypto era))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Decoder s (Set (TxIn (Crypto era)))
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (TxIn (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
1, Word8
16) -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) (Set (KeyHash 'StakePool (Crypto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery
  (ShelleyBlock proto era) (Set (KeyHash 'StakePool (Crypto era)))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (Set (KeyHash 'StakePool (EraCrypto era)))
GetStakePools
      (Int
2, Word8
17) -> BlockQuery
  (ShelleyBlock proto era)
  (Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (BlockQuery
   (ShelleyBlock proto era)
   (Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> (Set (KeyHash 'StakePool (Crypto era))
    -> BlockQuery
         (ShelleyBlock proto era)
         (Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))))
-> Set (KeyHash 'StakePool (Crypto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (KeyHash 'StakePool (Crypto era))
-> BlockQuery
     (ShelleyBlock proto era)
     (Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era)))
forall era proto.
Set (KeyHash 'StakePool (EraCrypto era))
-> BlockQuery
     (ShelleyBlock proto era)
     (Map
        (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
GetStakePoolParams (Set (KeyHash 'StakePool (Crypto era))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Decoder s (Set (KeyHash 'StakePool (Crypto era)))
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (KeyHash 'StakePool (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
1, Word8
18) -> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era)
  (RewardParams,
   Map (KeyHash 'StakePool (Crypto era)) RewardInfoPool)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond BlockQuery
  (ShelleyBlock proto era)
  (RewardParams,
   Map (KeyHash 'StakePool (Crypto era)) RewardInfoPool)
forall proto era.
BlockQuery
  (ShelleyBlock proto era)
  (RewardParams,
   Map (KeyHash 'StakePool (EraCrypto era)) RewardInfoPool)
GetRewardInfoPools
      (Int, Word8)
_       -> String
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> String
-> Decoder s (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$
        String
"decodeShelleyQuery: invalid (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
")"

encodeShelleyResult ::
     ShelleyCompatible proto era
  => BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
encodeShelleyResult :: BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
encodeShelleyResult BlockQuery (ShelleyBlock proto era) result
query = case BlockQuery (ShelleyBlock proto era) result
query of
    BlockQuery (ShelleyBlock proto era) result
GetLedgerTip                               -> (HeaderHash (ShelleyBlock proto era) -> Encoding)
-> Point (ShelleyBlock proto era) -> Encoding
forall block.
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint HeaderHash (ShelleyBlock proto era) -> Encoding
forall a. Serialise a => a -> Encoding
encode
    BlockQuery (ShelleyBlock proto era) result
GetEpochNo                                 -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
    GetNonMyopicMemberRewards {}               -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
    BlockQuery (ShelleyBlock proto era) result
GetCurrentPParams                          -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
GetProposedPParamsUpdates                  -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
GetStakeDistribution                       -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    GetUTxOByAddress {}                        -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
GetUTxOWhole                               -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
DebugEpochState                            -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    GetCBOR {}                                 -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
    GetFilteredDelegationsAndRewardAccounts {} -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
GetGenesisConfig                           -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
DebugNewEpochState                         -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
DebugChainDepState                         -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
    BlockQuery (ShelleyBlock proto era) result
GetRewardProvenance                        -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    GetUTxOByTxIn {}                           -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
GetStakePools                              -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    GetStakePoolParams {}                      -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    BlockQuery (ShelleyBlock proto era) result
GetRewardInfoPools                         -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

decodeShelleyResult ::
     ShelleyCompatible proto era
  => BlockQuery (ShelleyBlock proto era) result
  -> forall s. Decoder s result
decodeShelleyResult :: BlockQuery (ShelleyBlock proto era) result
-> forall s. Decoder s result
decodeShelleyResult BlockQuery (ShelleyBlock proto era) result
query = case BlockQuery (ShelleyBlock proto era) result
query of
    BlockQuery (ShelleyBlock proto era) result
GetLedgerTip                               -> (forall s. Decoder s (HeaderHash (ShelleyBlock proto era)))
-> forall s. Decoder s (Point (ShelleyBlock proto era))
forall block.
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint forall s. Decoder s (HeaderHash (ShelleyBlock proto era))
forall a s. Serialise a => Decoder s a
decode
    BlockQuery (ShelleyBlock proto era) result
GetEpochNo                                 -> Decoder s result
forall a s. Serialise a => Decoder s a
decode
    GetNonMyopicMemberRewards {}               -> Decoder s result
forall a s. Serialise a => Decoder s a
decode
    BlockQuery (ShelleyBlock proto era) result
GetCurrentPParams                          -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
GetProposedPParamsUpdates                  -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
GetStakeDistribution                       -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    GetUTxOByAddress {}                        -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
GetUTxOWhole                               -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
DebugEpochState                            -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    GetCBOR {}                                 -> Decoder s result
forall a s. Serialise a => Decoder s a
decode
    GetFilteredDelegationsAndRewardAccounts {} -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
GetGenesisConfig                           -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
DebugNewEpochState                         -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
DebugChainDepState                         -> Decoder s result
forall a s. Serialise a => Decoder s a
decode
    BlockQuery (ShelleyBlock proto era) result
GetRewardProvenance                        -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    GetUTxOByTxIn {}                           -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
GetStakePools                              -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    GetStakePoolParams {}                      -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    BlockQuery (ShelleyBlock proto era) result
GetRewardInfoPools                         -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR