{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DisambiguateRecordFields   #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Shelley.Ledger.Query (
    Query (..)
  , querySupportedVersion
  , NonMyopicMemberRewards (..)
    -- * Serialisation
  , encodeShelleyQuery
  , decodeShelleyQuery
  , encodeShelleyResult
  , decodeShelleyResult
  ) 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 qualified Data.Map.Strict as Map
import           Data.Set (Set)
import           Data.Type.Equality (apply)
import           Data.Typeable (Typeable)

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 Shelley.Spec.Ledger.API as SL
import qualified Shelley.Spec.Ledger.LedgerState as SL (RewardAccounts)

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 (..))
import           Ouroboros.Consensus.Shelley.Protocol (TPraosState (..))

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

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

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

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

data instance Query (ShelleyBlock era) :: Type -> Type where
  GetLedgerTip :: Query (ShelleyBlock era) (Point (ShelleyBlock era))
  GetEpochNo :: Query (ShelleyBlock 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 era))
    -> Query (ShelleyBlock era) (NonMyopicMemberRewards era)
  GetCurrentPParams
    :: Query (ShelleyBlock era) (SL.PParams era)
  GetProposedPParamsUpdates
    :: Query (ShelleyBlock 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
    :: Query (ShelleyBlock era) (SL.PoolDistr (EraCrypto era))
  GetFilteredUTxO
    :: Set (SL.Addr era)
    -> Query (ShelleyBlock era) (SL.UTxO era)
  GetUTxO
    :: Query (ShelleyBlock era) (SL.UTxO era)

  -- | Only for debugging purposes, we don't guarantee binary compatibility.
  -- Moreover, it is huge.
  DebugEpochState
    :: Query (ShelleyBlock 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
    :: Query (ShelleyBlock era) result
    -> Query (ShelleyBlock era) (Serialised result)

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

  GetGenesisConfig
    :: Query (ShelleyBlock era) (CompactGenesis era)

  -- | Only for debugging purposes, we don't guarantee binary compatibility.
  -- Moreover, it is huge.
  DebugNewEpochState
    :: Query (ShelleyBlock era) (SL.NewEpochState era)

  -- | Only for debugging purposes, we don't guarantee binary compatibility.
  DebugChainDepState
    :: Query (ShelleyBlock era) (SL.ChainDepState (EraCrypto era))

instance Typeable era => ShowProxy (Query (ShelleyBlock era)) where

instance ShelleyBasedEra era => QueryLedger (ShelleyBlock era) where
  answerQuery :: ExtLedgerCfg (ShelleyBlock era)
-> Query (ShelleyBlock era) result
-> ExtLedgerState (ShelleyBlock era)
-> result
answerQuery ExtLedgerCfg (ShelleyBlock era)
cfg Query (ShelleyBlock era) result
query ExtLedgerState (ShelleyBlock era)
ext =
      case Query (ShelleyBlock era) result
query of
        Query (ShelleyBlock era) result
GetLedgerTip ->
          LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
forall era.
LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
shelleyLedgerTipPoint LedgerState (ShelleyBlock era)
lst
        Query (ShelleyBlock era) result
GetEpochNo ->
          NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
SL.nesEL NewEpochState era
st
        GetNonMyopicMemberRewards creds ->
          Map
  (Either Coin (Credential 'Staking era))
  (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
-> NonMyopicMemberRewards era
forall era.
Map
  (Either Coin (Credential 'Staking era))
  (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
-> NonMyopicMemberRewards era
NonMyopicMemberRewards (Map
   (Either Coin (Credential 'Staking era))
   (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
 -> NonMyopicMemberRewards era)
-> Map
     (Either Coin (Credential 'Staking era))
     (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
-> NonMyopicMemberRewards era
forall a b. (a -> b) -> a -> b
$
            Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking era))
-> Map
     (Either Coin (Credential 'Staking era))
     (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
forall era.
ShelleyBased era =>
Globals
-> NewEpochState era
-> Set (Either Coin (Credential 'Staking era))
-> Map
     (Either Coin (Credential 'Staking era))
     (Map (KeyHash 'StakePool (Crypto era)) Coin)
SL.getNonMyopicMemberRewards Globals
globals NewEpochState era
st Set (Either Coin (Credential 'Staking era))
creds
        Query (ShelleyBlock era) result
GetCurrentPParams ->
          NewEpochState era -> PParams era
forall era. NewEpochState era -> PParams era
getPParams NewEpochState era
st
        Query (ShelleyBlock era) result
GetProposedPParamsUpdates ->
          NewEpochState era -> ProposedPPUpdates era
forall era. NewEpochState era -> ProposedPPUpdates era
getProposedPPUpdates NewEpochState era
st
        Query (ShelleyBlock era) result
GetStakeDistribution ->
          Globals -> NewEpochState era -> PoolDistr (EraCrypto era)
forall era.
ShelleyBased era =>
Globals -> NewEpochState era -> PoolDistr (Crypto era)
SL.poolsByTotalStakeFraction Globals
globals NewEpochState era
st
        GetFilteredUTxO addrs ->
          NewEpochState era -> Set (Addr era) -> UTxO era
forall era. NewEpochState era -> Set (Addr era) -> UTxO era
SL.getFilteredUTxO NewEpochState era
st Set (Addr era)
addrs
        Query (ShelleyBlock era) result
GetUTxO ->
          NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
SL.getUTxO NewEpochState era
st
        Query (ShelleyBlock 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 (Query (ShelleyBlock era) result -> result -> Encoding
forall era result.
ShelleyBasedEra era =>
Query (ShelleyBlock era) result -> result -> Encoding
encodeShelleyResult Query (ShelleyBlock era) result
query') (result -> Serialised result) -> result -> Serialised result
forall a b. (a -> b) -> a -> b
$
            ExtLedgerCfg (ShelleyBlock era)
-> Query (ShelleyBlock era) result
-> ExtLedgerState (ShelleyBlock era)
-> result
forall blk result.
QueryLedger blk =>
ExtLedgerCfg blk
-> Query blk result -> ExtLedgerState blk -> result
answerQuery ExtLedgerCfg (ShelleyBlock era)
cfg Query (ShelleyBlock era) result
query' ExtLedgerState (ShelleyBlock era)
ext
        GetFilteredDelegationsAndRewardAccounts creds ->
          NewEpochState era
-> Set (Credential 'Staking era)
-> (Delegations era, RewardAccounts era)
forall era.
NewEpochState era
-> Set (Credential 'Staking era)
-> (Delegations era, RewardAccounts era)
getFilteredDelegationsAndRewardAccounts NewEpochState era
st Set (Credential 'Staking era)
creds
        Query (ShelleyBlock era) result
GetGenesisConfig ->
          ShelleyLedgerConfig era -> CompactGenesis era
forall era. ShelleyLedgerConfig era -> CompactGenesis era
shelleyLedgerCompactGenesis LedgerConfig (ShelleyBlock era)
ShelleyLedgerConfig era
lcfg
        Query (ShelleyBlock era) result
DebugNewEpochState ->
          result
NewEpochState era
st
        Query (ShelleyBlock era) result
DebugChainDepState ->
          TPraosState (EraCrypto era) -> ChainDepState (EraCrypto era)
forall c. TPraosState c -> ChainDepState c
tpraosStateChainDepState (HeaderState (ShelleyBlock era)
-> ChainDepState (BlockProtocol (ShelleyBlock era))
forall blk. HeaderState blk -> ChainDepState (BlockProtocol blk)
headerStateChainDep HeaderState (ShelleyBlock era)
hst)
    where
      lcfg :: LedgerConfig (ShelleyBlock era)
lcfg    = TopLevelConfig (ShelleyBlock era)
-> LedgerConfig (ShelleyBlock era)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger (TopLevelConfig (ShelleyBlock era)
 -> LedgerConfig (ShelleyBlock era))
-> TopLevelConfig (ShelleyBlock era)
-> LedgerConfig (ShelleyBlock era)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg (ShelleyBlock era)
-> TopLevelConfig (ShelleyBlock era)
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg ExtLedgerCfg (ShelleyBlock era)
cfg
      globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock 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 era)
lst = ExtLedgerState (ShelleyBlock era) -> LedgerState (ShelleyBlock era)
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState ExtLedgerState (ShelleyBlock era)
ext
      hst :: HeaderState (ShelleyBlock era)
hst = ExtLedgerState (ShelleyBlock era) -> HeaderState (ShelleyBlock era)
forall blk. ExtLedgerState blk -> HeaderState blk
headerState ExtLedgerState (ShelleyBlock era)
ext
      st :: NewEpochState era
st  = LedgerState (ShelleyBlock era) -> NewEpochState era
forall era. LedgerState (ShelleyBlock era) -> NewEpochState era
shelleyLedgerState LedgerState (ShelleyBlock era)
lst

instance SameDepIndex (Query (ShelleyBlock era)) where
  sameDepIndex :: Query (ShelleyBlock era) a
-> Query (ShelleyBlock era) b -> Maybe (a :~: b)
sameDepIndex Query (ShelleyBlock era) a
GetLedgerTip Query (ShelleyBlock era) b
GetLedgerTip
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
GetLedgerTip Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
GetEpochNo Query (ShelleyBlock era) b
GetEpochNo
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
GetEpochNo Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetNonMyopicMemberRewards creds) (GetNonMyopicMemberRewards creds')
    | Set (Either Coin (Credential 'Staking era))
creds Set (Either Coin (Credential 'Staking era))
-> Set (Either Coin (Credential 'Staking era)) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Either Coin (Credential 'Staking 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 _) Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
GetCurrentPParams Query (ShelleyBlock era) b
GetCurrentPParams
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
GetCurrentPParams Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
GetProposedPParamsUpdates Query (ShelleyBlock era) b
GetProposedPParamsUpdates
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
GetProposedPParamsUpdates Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
GetStakeDistribution Query (ShelleyBlock era) b
GetStakeDistribution
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
GetStakeDistribution Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetFilteredUTxO addrs) (GetFilteredUTxO addrs')
    | Set (Addr era)
addrs Set (Addr era) -> Set (Addr era) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Addr 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 (GetFilteredUTxO _) Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
GetUTxO Query (ShelleyBlock era) b
GetUTxO
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
GetUTxO Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
DebugEpochState Query (ShelleyBlock era) b
DebugEpochState
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
DebugEpochState Query (ShelleyBlock 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
<$> Query (ShelleyBlock era) result
-> Query (ShelleyBlock era) result -> Maybe (result :~: result)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex Query (ShelleyBlock era) result
q Query (ShelleyBlock era) result
q'
  sameDepIndex (GetCBOR _) Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex (GetFilteredDelegationsAndRewardAccounts creds)
               (GetFilteredDelegationsAndRewardAccounts creds')
    | Set (Credential 'Staking era)
creds Set (Credential 'Staking era)
-> Set (Credential 'Staking era) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Credential 'Staking 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 _) Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
GetGenesisConfig Query (ShelleyBlock era) b
GetGenesisConfig
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
GetGenesisConfig Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
DebugNewEpochState Query (ShelleyBlock era) b
DebugNewEpochState
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
DebugNewEpochState Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing
  sameDepIndex Query (ShelleyBlock era) a
DebugChainDepState Query (ShelleyBlock era) b
DebugChainDepState
    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  sameDepIndex Query (ShelleyBlock era) a
DebugChainDepState Query (ShelleyBlock era) b
_
    = Maybe (a :~: b)
forall a. Maybe a
Nothing

deriving instance Eq   (Query (ShelleyBlock era) result)
deriving instance Show (Query (ShelleyBlock era) result)

instance ShelleyBasedEra era => ShowQuery (Query (ShelleyBlock era)) where
  showResult :: Query (ShelleyBlock era) result -> result -> String
showResult = \case
      Query (ShelleyBlock era) result
GetLedgerTip                               -> result -> String
forall a. Show a => a -> String
show
      Query (ShelleyBlock era) result
GetEpochNo                                 -> result -> String
forall a. Show a => a -> String
show
      GetNonMyopicMemberRewards {}               -> result -> String
forall a. Show a => a -> String
show
      Query (ShelleyBlock era) result
GetCurrentPParams                          -> result -> String
forall a. Show a => a -> String
show
      Query (ShelleyBlock era) result
GetProposedPParamsUpdates                  -> result -> String
forall a. Show a => a -> String
show
      Query (ShelleyBlock era) result
GetStakeDistribution                       -> result -> String
forall a. Show a => a -> String
show
      GetFilteredUTxO {}                         -> result -> String
forall a. Show a => a -> String
show
      Query (ShelleyBlock era) result
GetUTxO                                    -> result -> String
forall a. Show a => a -> String
show
      Query (ShelleyBlock 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
      Query (ShelleyBlock era) result
GetGenesisConfig                           -> result -> String
forall a. Show a => a -> String
show
      Query (ShelleyBlock era) result
DebugNewEpochState                         -> result -> String
forall a. Show a => a -> String
show
      Query (ShelleyBlock era) result
DebugChainDepState                         -> result -> String
forall a. Show a => a -> String
show

-- | Is the given query supported by the given 'ShelleyNodeToClientVersion'?
querySupportedVersion :: Query (ShelleyBlock era) result -> ShelleyNodeToClientVersion -> Bool
querySupportedVersion :: Query (ShelleyBlock era) result
-> ShelleyNodeToClientVersion -> Bool
querySupportedVersion = \case
    Query (ShelleyBlock era) result
GetLedgerTip                               -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    Query (ShelleyBlock 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)
    Query (ShelleyBlock era) result
GetCurrentPParams                          -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    Query (ShelleyBlock era) result
GetProposedPParamsUpdates                  -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    Query (ShelleyBlock era) result
GetStakeDistribution                       -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    GetFilteredUTxO {}                         -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    Query (ShelleyBlock era) result
GetUTxO                                    -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    Query (ShelleyBlock era) result
DebugEpochState                            -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    GetCBOR q                                  -> Query (ShelleyBlock era) result
-> ShelleyNodeToClientVersion -> Bool
forall era result.
Query (ShelleyBlock era) result
-> ShelleyNodeToClientVersion -> Bool
querySupportedVersion Query (ShelleyBlock era) result
q
    GetFilteredDelegationsAndRewardAccounts {} -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v1)
    Query (ShelleyBlock era) result
GetGenesisConfig                           -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v2)
    Query (ShelleyBlock era) result
DebugNewEpochState                         -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v2)
    Query (ShelleyBlock era) result
DebugChainDepState                         -> (ShelleyNodeToClientVersion -> ShelleyNodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= ShelleyNodeToClientVersion
v2)
  where
    v1 :: ShelleyNodeToClientVersion
v1 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion1
    v2 :: ShelleyNodeToClientVersion
v2 = ShelleyNodeToClientVersion
ShelleyNodeToClientVersion2

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

getProposedPPUpdates :: 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 -> PPUPState 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._utxoState (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 era
getDState :: NewEpochState era -> DState era
getDState = DPState era -> DState era
forall era. DPState era -> DState era
SL._dstate (DPState era -> DState era)
-> (NewEpochState era -> DPState era)
-> NewEpochState era
-> DState era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState era -> DPState era
forall era. LedgerState era -> DPState era
SL._delegationState (LedgerState era -> DPState era)
-> (NewEpochState era -> LedgerState era)
-> NewEpochState era
-> DPState 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 era)
                                        -> (Delegations era, SL.RewardAccounts era)
getFilteredDelegationsAndRewardAccounts :: NewEpochState era
-> Set (Credential 'Staking era)
-> (Delegations era, RewardAccounts era)
getFilteredDelegationsAndRewardAccounts NewEpochState era
ss Set (Credential 'Staking era)
creds =
    (Delegations era
filteredDelegations, RewardAccounts era
filteredRwdAcnts)
  where
    SL.DState { _rewards :: forall era. DState era -> RewardAccounts era
_rewards = RewardAccounts era
rewards, _delegations :: forall era.
DState era
-> Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era))
_delegations = Delegations era
delegations } = NewEpochState era -> DState era
forall era. NewEpochState era -> DState era
getDState NewEpochState era
ss
    filteredDelegations :: Delegations era
filteredDelegations = Delegations era -> Set (Credential 'Staking era) -> Delegations era
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Delegations era
delegations Set (Credential 'Staking era)
creds
    filteredRwdAcnts :: RewardAccounts era
filteredRwdAcnts = RewardAccounts era
-> Set (Credential 'Staking era) -> RewardAccounts era
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys RewardAccounts era
rewards Set (Credential 'Staking era)
creds

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

encodeShelleyQuery ::
     ShelleyBasedEra era
  => Query (ShelleyBlock era) result -> Encoding
encodeShelleyQuery :: Query (ShelleyBlock era) result -> Encoding
encodeShelleyQuery Query (ShelleyBlock era) result
query = case Query (ShelleyBlock era) result
query of
    Query (ShelleyBlock 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
    Query (ShelleyBlock 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 era)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Either Coin (Credential 'Staking era))
creds
    Query (ShelleyBlock 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
    Query (ShelleyBlock 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
    Query (ShelleyBlock 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
    GetFilteredUTxO 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 era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Addr era)
addrs
    Query (ShelleyBlock era) result
GetUTxO ->
      Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
7
    Query (ShelleyBlock 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
<> Query (ShelleyBlock era) result -> Encoding
forall era result.
ShelleyBasedEra era =>
Query (ShelleyBlock era) result -> Encoding
encodeShelleyQuery Query (ShelleyBlock 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 era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set (Credential 'Staking era)
creds
    Query (ShelleyBlock 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
    Query (ShelleyBlock 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
    Query (ShelleyBlock 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

decodeShelleyQuery ::
     ShelleyBasedEra era
  => Decoder s (SomeSecond Query (ShelleyBlock era))
decodeShelleyQuery :: Decoder s (SomeSecond Query (ShelleyBlock 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 Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (Point (ShelleyBlock era))
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (Point (ShelleyBlock era))
forall era. Query (ShelleyBlock era) (Point (ShelleyBlock era))
GetLedgerTip
      (Int
1, Word8
1)  -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) EpochNo
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) EpochNo
forall era. Query (ShelleyBlock era) EpochNo
GetEpochNo
      (Int
2, Word8
2)  -> Query (ShelleyBlock era) (NonMyopicMemberRewards era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (Query (ShelleyBlock era) (NonMyopicMemberRewards era)
 -> SomeSecond Query (ShelleyBlock era))
-> (Set (Either Coin (Credential 'Staking era))
    -> Query (ShelleyBlock era) (NonMyopicMemberRewards era))
-> Set (Either Coin (Credential 'Staking era))
-> SomeSecond Query (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either Coin (Credential 'Staking era))
-> Query (ShelleyBlock era) (NonMyopicMemberRewards era)
forall era.
Set (Either Coin (Credential 'Staking era))
-> Query (ShelleyBlock era) (NonMyopicMemberRewards era)
GetNonMyopicMemberRewards (Set (Either Coin (Credential 'Staking era))
 -> SomeSecond Query (ShelleyBlock era))
-> Decoder s (Set (Either Coin (Credential 'Staking era)))
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Either Coin (Credential 'Staking era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
1, Word8
3)  -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (PParams era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (PParams era)
forall era. Query (ShelleyBlock era) (PParams era)
GetCurrentPParams
      (Int
1, Word8
4)  -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (ProposedPPUpdates era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (ProposedPPUpdates era)
forall era. Query (ShelleyBlock era) (ProposedPPUpdates era)
GetProposedPParamsUpdates
      (Int
1, Word8
5)  -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (PoolDistr (Crypto era))
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (PoolDistr (Crypto era))
forall era. Query (ShelleyBlock era) (PoolDistr (EraCrypto era))
GetStakeDistribution
      (Int
2, Word8
6)  -> Query (ShelleyBlock era) (UTxO era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (Query (ShelleyBlock era) (UTxO era)
 -> SomeSecond Query (ShelleyBlock era))
-> (Set (Addr era) -> Query (ShelleyBlock era) (UTxO era))
-> Set (Addr era)
-> SomeSecond Query (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Addr era) -> Query (ShelleyBlock era) (UTxO era)
forall era. Set (Addr era) -> Query (ShelleyBlock era) (UTxO era)
GetFilteredUTxO (Set (Addr era) -> SomeSecond Query (ShelleyBlock era))
-> Decoder s (Set (Addr era))
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Addr era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
1, Word8
7)  -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (UTxO era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (UTxO era)
forall era. Query (ShelleyBlock era) (UTxO era)
GetUTxO
      (Int
1, Word8
8)  -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (EpochState era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (EpochState era)
forall era. Query (ShelleyBlock era) (EpochState era)
DebugEpochState
      (Int
2, Word8
9)  -> (\(SomeSecond Query (ShelleyBlock era) b
q) -> Query (ShelleyBlock era) (Serialised b)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (Query (ShelleyBlock era) b
-> Query (ShelleyBlock era) (Serialised b)
forall era result.
Query (ShelleyBlock era) result
-> Query (ShelleyBlock era) (Serialised result)
GetCBOR Query (ShelleyBlock era) b
q)) (SomeSecond Query (ShelleyBlock era)
 -> SomeSecond Query (ShelleyBlock era))
-> Decoder s (SomeSecond Query (ShelleyBlock era))
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (SomeSecond Query (ShelleyBlock era))
forall era s.
ShelleyBasedEra era =>
Decoder s (SomeSecond Query (ShelleyBlock era))
decodeShelleyQuery
      (Int
2, Word8
10) -> Query
  (ShelleyBlock era)
  (Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era)),
   RewardAccounts era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond (Query
   (ShelleyBlock era)
   (Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era)),
    RewardAccounts era)
 -> SomeSecond Query (ShelleyBlock era))
-> (Set (Credential 'Staking era)
    -> Query
         (ShelleyBlock era)
         (Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era)),
          RewardAccounts era))
-> Set (Credential 'Staking era)
-> SomeSecond Query (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'Staking era)
-> Query
     (ShelleyBlock era)
     (Map (Credential 'Staking era) (KeyHash 'StakePool (Crypto era)),
      RewardAccounts era)
forall era.
Set (Credential 'Staking era)
-> Query (ShelleyBlock era) (Delegations era, RewardAccounts era)
GetFilteredDelegationsAndRewardAccounts (Set (Credential 'Staking era)
 -> SomeSecond Query (ShelleyBlock era))
-> Decoder s (Set (Credential 'Staking era))
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Set (Credential 'Staking era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
1, Word8
11) -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (CompactGenesis era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (CompactGenesis era)
forall era. Query (ShelleyBlock era) (CompactGenesis era)
GetGenesisConfig
      (Int
1, Word8
12) -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (NewEpochState era)
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (NewEpochState era)
forall era. Query (ShelleyBlock era) (NewEpochState era)
DebugNewEpochState
      (Int
1, Word8
13) -> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond Query (ShelleyBlock era)
 -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> SomeSecond Query (ShelleyBlock era)
-> Decoder s (SomeSecond Query (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ Query (ShelleyBlock era) (ChainDepState (Crypto era))
-> SomeSecond Query (ShelleyBlock era)
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond Query (ShelleyBlock era) (ChainDepState (Crypto era))
forall era.
Query (ShelleyBlock era) (ChainDepState (EraCrypto era))
DebugChainDepState
      (Int, Word8)
_       -> String -> Decoder s (SomeSecond Query (ShelleyBlock era))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeSecond Query (ShelleyBlock era)))
-> String -> Decoder s (SomeSecond Query (ShelleyBlock 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 ::
     ShelleyBasedEra era
  => Query (ShelleyBlock era) result -> result -> Encoding
encodeShelleyResult :: Query (ShelleyBlock era) result -> result -> Encoding
encodeShelleyResult Query (ShelleyBlock era) result
query = case Query (ShelleyBlock era) result
query of
    Query (ShelleyBlock era) result
GetLedgerTip                               -> (HeaderHash (ShelleyBlock era) -> Encoding)
-> Point (ShelleyBlock era) -> Encoding
forall block.
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint HeaderHash (ShelleyBlock era) -> Encoding
forall a. Serialise a => a -> Encoding
encode
    Query (ShelleyBlock era) result
GetEpochNo                                 -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
    GetNonMyopicMemberRewards {}               -> result -> Encoding
forall a. Serialise a => a -> Encoding
encode
    Query (ShelleyBlock era) result
GetCurrentPParams                          -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Query (ShelleyBlock era) result
GetProposedPParamsUpdates                  -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Query (ShelleyBlock era) result
GetStakeDistribution                       -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    GetFilteredUTxO {}                         -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Query (ShelleyBlock era) result
GetUTxO                                    -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Query (ShelleyBlock 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
    Query (ShelleyBlock era) result
GetGenesisConfig                           -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Query (ShelleyBlock era) result
DebugNewEpochState                         -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Query (ShelleyBlock era) result
DebugChainDepState                         -> result -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

decodeShelleyResult ::
     ShelleyBasedEra era
  => Query (ShelleyBlock era) result
  -> forall s. Decoder s result
decodeShelleyResult :: Query (ShelleyBlock era) result -> forall s. Decoder s result
decodeShelleyResult Query (ShelleyBlock era) result
query = case Query (ShelleyBlock era) result
query of
    Query (ShelleyBlock era) result
GetLedgerTip                               -> (forall s. Decoder s (HeaderHash (ShelleyBlock era)))
-> forall s. Decoder s (Point (ShelleyBlock era))
forall block.
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint forall s. Decoder s (HeaderHash (ShelleyBlock era))
forall a s. Serialise a => Decoder s a
decode
    Query (ShelleyBlock 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
    Query (ShelleyBlock era) result
GetCurrentPParams                          -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Query (ShelleyBlock era) result
GetProposedPParamsUpdates                  -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Query (ShelleyBlock era) result
GetStakeDistribution                       -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    GetFilteredUTxO {}                         -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Query (ShelleyBlock era) result
GetUTxO                                    -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Query (ShelleyBlock 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
    Query (ShelleyBlock era) result
GetGenesisConfig                           -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Query (ShelleyBlock era) result
DebugNewEpochState                         -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Query (ShelleyBlock era) result
DebugChainDepState                         -> Decoder s result
forall a s. FromCBOR a => Decoder s a
fromCBOR