{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | Convenience query functions
module Cardano.Api.Convenience.Query
  ( QueryConvenienceError (..)
  , TxCurrentTreasuryValue (..)
  , determineEra

    -- * Simplest query related
  , executeQueryCardanoMode
  , executeQueryAnyMode
  , queryStateForBalancedTx
  , renderQueryConvenienceError
  )
where

import           Cardano.Api.Address
import           Cardano.Api.Certificate
import           Cardano.Api.Eon.ConwayEraOnwards
import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eras
import           Cardano.Api.Feature (Featured (..))
import           Cardano.Api.IO
import           Cardano.Api.IPC
import           Cardano.Api.IPC.Monad
import           Cardano.Api.Monad.Error
import           Cardano.Api.NetworkId
import           Cardano.Api.ProtocolParameters
import           Cardano.Api.Query
import           Cardano.Api.Query.Expr
import           Cardano.Api.Tx.Body
import           Cardano.Api.Utils

import qualified Cardano.Ledger.Api as L
import           Cardano.Ledger.CertState (DRepState (..))
import qualified Cardano.Ledger.Coin as L
import qualified Cardano.Ledger.Credential as L
import qualified Cardano.Ledger.Keys as L
import qualified Cardano.Ledger.Shelley.LedgerState as L
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..))
import           Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..))

import           Control.Exception.Safe (SomeException, displayException)
import           Control.Monad
import           Data.Bifunctor (first)
import           Data.Function ((&))
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Maybe (mapMaybe)
import           Data.Set (Set)
import           Data.Text (Text)
import           GHC.Exts (IsList (..), IsString (..))

data QueryConvenienceError
  = AcqFailure AcquiringFailure
  | QueryEraMismatch EraMismatch
  | ByronEraNotSupported
  | QceUnsupportedNtcVersion !UnsupportedNtcVersionError
  | QceUnexpectedException !SomeException
  deriving Int -> QueryConvenienceError -> ShowS
[QueryConvenienceError] -> ShowS
QueryConvenienceError -> String
(Int -> QueryConvenienceError -> ShowS)
-> (QueryConvenienceError -> String)
-> ([QueryConvenienceError] -> ShowS)
-> Show QueryConvenienceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryConvenienceError -> ShowS
showsPrec :: Int -> QueryConvenienceError -> ShowS
$cshow :: QueryConvenienceError -> String
show :: QueryConvenienceError -> String
$cshowList :: [QueryConvenienceError] -> ShowS
showList :: [QueryConvenienceError] -> ShowS
Show

renderQueryConvenienceError :: QueryConvenienceError -> Text
renderQueryConvenienceError :: QueryConvenienceError -> Text
renderQueryConvenienceError (AcqFailure AcquiringFailure
e) =
  Text
"Acquiring failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AcquiringFailure -> Text
forall a. Show a => a -> Text
textShow AcquiringFailure
e
renderQueryConvenienceError (QueryEraMismatch (EraMismatch Text
ledgerEraName' Text
otherEraName')) =
  Text
"The era of the node and the tx do not match. "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"The node is running in the "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ledgerEraName'
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" era, but the transaction is for the "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
otherEraName'
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" era."
renderQueryConvenienceError QueryConvenienceError
ByronEraNotSupported =
  Text
"Byron era not supported"
renderQueryConvenienceError (QceUnsupportedNtcVersion (UnsupportedNtcVersionError MinNodeToClientVersion
minNtcVersion MinNodeToClientVersion
ntcVersion)) =
  Text
"Unsupported feature for the node-to-client protocol version.\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"This query requires at least "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MinNodeToClientVersion -> Text
forall a. Show a => a -> Text
textShow MinNodeToClientVersion
minNtcVersion
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but the node negotiated "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MinNodeToClientVersion -> Text
forall a. Show a => a -> Text
textShow MinNodeToClientVersion
ntcVersion
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)."
renderQueryConvenienceError (QceUnexpectedException SomeException
e) =
  Text
"Unexpected exception while processing query:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
e)

newtype TxCurrentTreasuryValue = TxCurrentTreasuryValue {TxCurrentTreasuryValue -> Coin
unTxCurrentTreasuryValue :: L.Coin}
  deriving newtype Int -> TxCurrentTreasuryValue -> ShowS
[TxCurrentTreasuryValue] -> ShowS
TxCurrentTreasuryValue -> String
(Int -> TxCurrentTreasuryValue -> ShowS)
-> (TxCurrentTreasuryValue -> String)
-> ([TxCurrentTreasuryValue] -> ShowS)
-> Show TxCurrentTreasuryValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxCurrentTreasuryValue -> ShowS
showsPrec :: Int -> TxCurrentTreasuryValue -> ShowS
$cshow :: TxCurrentTreasuryValue -> String
show :: TxCurrentTreasuryValue -> String
$cshowList :: [TxCurrentTreasuryValue] -> ShowS
showList :: [TxCurrentTreasuryValue] -> ShowS
Show

-- | A convenience function to query the relevant information, from
-- the local node, for Cardano.Api.Convenience.Construction.constructBalancedTx
queryStateForBalancedTx
  :: ()
  => CardanoEra era
  -> [TxIn]
  -> [Certificate era]
  -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      ( Either
          QueryConvenienceError
          ( UTxO era
          , LedgerProtocolParameters era
          , EraHistory
          , SystemStart
          , Set PoolId
          , Map StakeCredential L.Coin
          , Map (L.Credential L.DRepRole L.StandardCrypto) L.Coin
          , Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
          )
      )
queryStateForBalancedTx :: forall era block point r.
CardanoEra era
-> [TxIn]
-> [Certificate era]
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Coin,
         Map (Credential 'DRepRole StandardCrypto) Coin,
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
queryStateForBalancedTx CardanoEra era
era [TxIn]
allTxIns [Certificate era]
certs = ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
   Set PoolId, Map StakeCredential Coin,
   Map (Credential 'DRepRole StandardCrypto) Coin,
   Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Coin,
         Map (Credential 'DRepRole StandardCrypto) Coin,
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryConvenienceError
   (LocalStateQueryExpr block point QueryInMode r IO)
   (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
    Set PoolId, Map StakeCredential Coin,
    Map (Credential 'DRepRole StandardCrypto) Coin,
    Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
 -> LocalStateQueryExpr
      block
      point
      QueryInMode
      r
      IO
      (Either
         QueryConvenienceError
         (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
          Set PoolId, Map StakeCredential Coin,
          Map (Credential 'DRepRole StandardCrypto) Coin,
          Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Coin,
      Map (Credential 'DRepRole StandardCrypto) Coin,
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        QueryConvenienceError
        (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
         Set PoolId, Map StakeCredential Coin,
         Map (Credential 'DRepRole StandardCrypto) Coin,
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall a b. (a -> b) -> a -> b
$ do
  ShelleyBasedEra era
sbe <-
    CardanoEra era
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryConvenienceError
ByronEraNotSupported)

  let stakeCreds :: Set StakeCredential
stakeCreds = [Item (Set StakeCredential)] -> Set StakeCredential
forall l. IsList l => [Item l] -> l
fromList ([Item (Set StakeCredential)] -> Set StakeCredential)
-> [Item (Set StakeCredential)] -> Set StakeCredential
forall a b. (a -> b) -> a -> b
$ (Certificate era -> Maybe StakeCredential)
-> [Certificate era] -> [StakeCredential]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Certificate era -> Maybe StakeCredential
forall era. Certificate era -> Maybe StakeCredential
filterUnRegCreds [Certificate era]
certs
      drepCreds :: Set (Credential 'DRepRole StandardCrypto)
drepCreds = [Item (Set (Credential 'DRepRole StandardCrypto))]
-> Set (Credential 'DRepRole StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList ([Item (Set (Credential 'DRepRole StandardCrypto))]
 -> Set (Credential 'DRepRole StandardCrypto))
-> [Item (Set (Credential 'DRepRole StandardCrypto))]
-> Set (Credential 'DRepRole StandardCrypto)
forall a b. (a -> b) -> a -> b
$ (Certificate era -> Maybe (Credential 'DRepRole StandardCrypto))
-> [Certificate era] -> [Credential 'DRepRole StandardCrypto]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Certificate era -> Maybe (Credential 'DRepRole StandardCrypto)
forall era.
Certificate era -> Maybe (Credential 'DRepRole StandardCrypto)
filterUnRegDRepCreds [Certificate era]
certs

  -- Query execution
  UTxO era
utxo <-
    LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT QueryConvenienceError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
forall era block point r.
ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
queryUtxo ShelleyBasedEra era
sbe (Set TxIn -> QueryUTxOFilter
QueryUTxOByTxIn ([Item (Set TxIn)] -> Set TxIn
forall l. IsList l => [Item l] -> l
fromList [Item (Set TxIn)]
[TxIn]
allTxIns)))
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Either EraMismatch (UTxO era)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (UTxO era))
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (UTxO era)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (UTxO era))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (UTxO era))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (UTxO era)))
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (UTxO era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either EraMismatch (UTxO era))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (UTxO era))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (UTxO era))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (UTxO era)
forall a b. a -> (a -> b) -> b
& (EraMismatch
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (UTxO era))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (UTxO era))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (UTxO era)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (UTxO era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (UTxO era))
-> (EraMismatch -> QueryConvenienceError)
-> EraMismatch
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (UTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryConvenienceError
QueryEraMismatch)

  PParams (ShelleyLedgerEra era)
pparams <-
    LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT QueryConvenienceError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
queryProtocolParameters ShelleyBasedEra era
sbe)
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (PParams (ShelleyLedgerEra era))))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either EraMismatch (PParams (ShelleyLedgerEra era)))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (PParams (ShelleyLedgerEra era)))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (PParams (ShelleyLedgerEra era)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (PParams (ShelleyLedgerEra era))
forall a b. a -> (a -> b) -> b
& (EraMismatch
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (PParams (ShelleyLedgerEra era)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (PParams (ShelleyLedgerEra era))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (PParams (ShelleyLedgerEra era))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (PParams (ShelleyLedgerEra era)))
-> (EraMismatch -> QueryConvenienceError)
-> EraMismatch
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (PParams (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryConvenienceError
QueryEraMismatch)

  EraHistory
eraHistory <-
    LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError EraHistory)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either UnsupportedNtcVersionError EraHistory)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT QueryConvenienceError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError EraHistory)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError EraHistory)
queryEraHistory
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either UnsupportedNtcVersionError EraHistory)
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either UnsupportedNtcVersionError EraHistory)
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         EraHistory)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     EraHistory
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      EraHistory)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either UnsupportedNtcVersionError EraHistory)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     EraHistory
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     EraHistory
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      EraHistory)
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     EraHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)

  SystemStart
systemStart <-
    LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError SystemStart)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either UnsupportedNtcVersionError SystemStart)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT QueryConvenienceError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError SystemStart)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError SystemStart)
querySystemStart
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either UnsupportedNtcVersionError SystemStart)
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either UnsupportedNtcVersionError SystemStart)
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         SystemStart)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     SystemStart
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      SystemStart)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either UnsupportedNtcVersionError SystemStart)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     SystemStart
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     SystemStart
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      SystemStart)
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     SystemStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)

  Set PoolId
stakePools <-
    LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either
     UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT QueryConvenienceError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
queryStakePools ShelleyBasedEra era
sbe)
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either
     UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Either EraMismatch (Set PoolId)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Set PoolId))
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (Set PoolId)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Set PoolId))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Set PoolId))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (Set PoolId)))
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Set PoolId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)
      ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either EraMismatch (Set PoolId))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (Set PoolId))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Set PoolId))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Set PoolId)
forall a b. a -> (a -> b) -> b
& (EraMismatch
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Set PoolId))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Set PoolId))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Set PoolId)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Set PoolId)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Set PoolId))
-> (EraMismatch -> QueryConvenienceError)
-> EraMismatch
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Set PoolId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryConvenienceError
QueryEraMismatch)

  Map StakeCredential Coin
stakeDelegDeposits <-
    CardanoEra era
-> (BabbageEraOnwards era
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Map StakeCredential Coin))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map StakeCredential Coin)
forall (eon :: * -> *) (f :: * -> *) a era.
(Eon eon, Applicative f, Monoid a) =>
CardanoEra era -> (eon era -> f a) -> f a
monoidForEraInEonA CardanoEra era
era ((BabbageEraOnwards era
  -> ExceptT
       QueryConvenienceError
       (LocalStateQueryExpr block point QueryInMode r IO)
       (Map StakeCredential Coin))
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Map StakeCredential Coin))
-> (BabbageEraOnwards era
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Map StakeCredential Coin))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map StakeCredential Coin)
forall a b. (a -> b) -> a -> b
$ \BabbageEraOnwards era
beo ->
      LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Map StakeCredential Coin)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT QueryConvenienceError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (BabbageEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
forall era block point r.
BabbageEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
queryStakeDelegDeposits BabbageEraOnwards era
beo Set StakeCredential
stakeCreds)
        ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Map StakeCredential Coin)))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map StakeCredential Coin)))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Either EraMismatch (Map StakeCredential Coin)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map StakeCredential Coin))
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (Map StakeCredential Coin)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Coin)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map StakeCredential Coin))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map StakeCredential Coin))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (Map StakeCredential Coin)))
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map StakeCredential Coin))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)
        ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either EraMismatch (Map StakeCredential Coin))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (Map StakeCredential Coin))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Map StakeCredential Coin))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map StakeCredential Coin)
forall a b. a -> (a -> b) -> b
& (EraMismatch
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Map StakeCredential Coin))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map StakeCredential Coin))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map StakeCredential Coin)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map StakeCredential Coin)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Map StakeCredential Coin))
-> (EraMismatch -> QueryConvenienceError)
-> EraMismatch
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map StakeCredential Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryConvenienceError
QueryEraMismatch)

  Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits <-
    CardanoEra era
-> (ConwayEraOnwards era
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Map (Credential 'DRepRole StandardCrypto) Coin))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map (Credential 'DRepRole StandardCrypto) Coin)
forall (eon :: * -> *) (f :: * -> *) a era.
(Eon eon, Applicative f, Monoid a) =>
CardanoEra era -> (eon era -> f a) -> f a
monoidForEraInEonA CardanoEra era
era ((ConwayEraOnwards era
  -> ExceptT
       QueryConvenienceError
       (LocalStateQueryExpr block point QueryInMode r IO)
       (Map (Credential 'DRepRole StandardCrypto) Coin))
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Map (Credential 'DRepRole StandardCrypto) Coin))
-> (ConwayEraOnwards era
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Map (Credential 'DRepRole StandardCrypto) Coin))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map (Credential 'DRepRole StandardCrypto) Coin)
forall a b. (a -> b) -> a -> b
$ \ConwayEraOnwards era
con ->
      (DRepState StandardCrypto -> Coin)
-> Map
     (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
-> Map (Credential 'DRepRole StandardCrypto) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map DRepState StandardCrypto -> Coin
forall c. DRepState c -> Coin
drepDeposit
        (Map
   (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
 -> Map (Credential 'DRepRole StandardCrypto) Coin)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map
        (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map (Credential 'DRepRole StandardCrypto) Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either
     UnsupportedNtcVersionError
     (Either
        EraMismatch
        (Map
           (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT QueryConvenienceError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ConwayEraOnwards era
-> Set (Credential 'DRepRole StandardCrypto)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
forall era block point r.
ConwayEraOnwards era
-> Set (Credential 'DRepRole StandardCrypto)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
queryDRepState ConwayEraOnwards era
con Set (Credential 'DRepRole StandardCrypto)
drepCreds)
                ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either
     UnsupportedNtcVersionError
     (Either
        EraMismatch
        (Map
           (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         UnsupportedNtcVersionError
         (Either
            EraMismatch
            (Map
               (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Either
            EraMismatch
            (Map
               (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        EraMismatch
        (Map
           (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         EraMismatch
         (Map
            (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        EraMismatch
        (Map
           (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        EraMismatch
        (Map
           (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         EraMismatch
         (Map
            (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        EraMismatch
        (Map
           (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)
                ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either
     EraMismatch
     (Map
        (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         EraMismatch
         (Map
            (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Map
            (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map
        (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
forall a b. a -> (a -> b) -> b
& (EraMismatch
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Map
         (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        EraMismatch
        (Map
           (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map
        (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map
        (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Map
         (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
-> (EraMismatch -> QueryConvenienceError)
-> EraMismatch
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map
        (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryConvenienceError
QueryEraMismatch)
            )

  Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
featuredTxTreasuryValueM <-
    (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> ShelleyBasedEra era
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
      (ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
-> ShelleyToBabbageEra era
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall a b. a -> b -> a
const (ExceptT
   QueryConvenienceError
   (LocalStateQueryExpr block point QueryInMode r IO)
   (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
 -> ShelleyToBabbageEra era
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
-> ShelleyToBabbageEra era
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall a b. (a -> b) -> a -> b
$ Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall a.
a
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
forall a. Maybe a
Nothing)
      ( \ConwayEraOnwards era
cOnwards -> do
          L.AccountState{Coin
asTreasury :: Coin
asTreasury :: AccountState -> Coin
L.asTreasury} <-
            LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either
     UnsupportedNtcVersionError (Either EraMismatch AccountState))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT QueryConvenienceError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
queryAccountState ConwayEraOnwards era
cOnwards)
              ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either
     UnsupportedNtcVersionError (Either EraMismatch AccountState))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         UnsupportedNtcVersionError (Either EraMismatch AccountState))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Either EraMismatch AccountState))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch AccountState)
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch AccountState))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch AccountState)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch AccountState)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch AccountState))
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch AccountState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryConvenienceError
QceUnsupportedNtcVersion)
              ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either EraMismatch AccountState)
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch AccountState)
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         AccountState)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     AccountState
forall a b. a -> (a -> b) -> b
& (EraMismatch
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      AccountState)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch AccountState)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     AccountState
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryConvenienceError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     AccountState
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      AccountState)
-> (EraMismatch -> QueryConvenienceError)
-> EraMismatch
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     AccountState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryConvenienceError
QueryEraMismatch)
          let txCurrentTreasuryValue :: TxCurrentTreasuryValue
txCurrentTreasuryValue = Coin -> TxCurrentTreasuryValue
TxCurrentTreasuryValue Coin
asTreasury
          Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall a.
a
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
-> Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall a b. (a -> b) -> a -> b
$ Featured ConwayEraOnwards era TxCurrentTreasuryValue
-> Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
forall a. a -> Maybe a
Just (Featured ConwayEraOnwards era TxCurrentTreasuryValue
 -> Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
-> Featured ConwayEraOnwards era TxCurrentTreasuryValue
-> Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> TxCurrentTreasuryValue
-> Featured ConwayEraOnwards era TxCurrentTreasuryValue
forall (eon :: * -> *) era a. eon era -> a -> Featured eon era a
Featured ConwayEraOnwards era
cOnwards TxCurrentTreasuryValue
txCurrentTreasuryValue
      )
      ShelleyBasedEra era
sbe

  (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
 Set PoolId, Map StakeCredential Coin,
 Map (Credential 'DRepRole StandardCrypto) Coin,
 Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (UTxO era, LedgerProtocolParameters era, EraHistory, SystemStart,
      Set PoolId, Map StakeCredential Coin,
      Map (Credential 'DRepRole StandardCrypto) Coin,
      Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue))
forall a.
a
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( UTxO era
utxo
    , PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams (ShelleyLedgerEra era)
pparams
    , EraHistory
eraHistory
    , SystemStart
systemStart
    , Set PoolId
stakePools
    , Map StakeCredential Coin
stakeDelegDeposits
    , Map (Credential 'DRepRole StandardCrypto) Coin
drepDelegDeposits
    , Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)
featuredTxTreasuryValueM
    )

-- | Query the node to determine which era it is in.
determineEra
  :: ()
  => LocalNodeConnectInfo
  -> ExceptT AcquiringFailure IO AnyCardanoEra
determineEra :: LocalNodeConnectInfo -> ExceptT AcquiringFailure IO AnyCardanoEra
determineEra LocalNodeConnectInfo
localNodeConnInfo =
  LocalNodeConnectInfo
-> Target ChainPoint
-> QueryInMode AnyCardanoEra
-> ExceptT AcquiringFailure IO AnyCardanoEra
forall result.
LocalNodeConnectInfo
-> Target ChainPoint
-> QueryInMode result
-> ExceptT AcquiringFailure IO result
queryNodeLocalState LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
forall point. Target point
VolatileTip QueryInMode AnyCardanoEra
QueryCurrentEra

-- | Execute a query against the local node. The local
-- node must be in CardanoMode.
executeQueryCardanoMode
  :: ()
  => SocketPath
  -> NetworkId
  -> QueryInMode (Either EraMismatch result)
  -> ExceptT QueryConvenienceError IO result
executeQueryCardanoMode :: forall result.
SocketPath
-> NetworkId
-> QueryInMode (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO result
executeQueryCardanoMode SocketPath
socketPath NetworkId
nid QueryInMode (Either EraMismatch result)
q = do
  let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo =
        LocalNodeConnectInfo
          { localConsensusModeParams :: ConsensusModeParams
localConsensusModeParams = EpochSlots -> ConsensusModeParams
CardanoModeParams (Word64 -> EpochSlots
EpochSlots Word64
21600)
          , localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
nid
          , localNodeSocketPath :: SocketPath
localNodeSocketPath = SocketPath
socketPath
          }

  LocalNodeConnectInfo
-> QueryInMode (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO result
forall result.
LocalNodeConnectInfo
-> QueryInMode (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO result
executeQueryAnyMode LocalNodeConnectInfo
localNodeConnInfo QueryInMode (Either EraMismatch result)
q

-- | Execute a query against the local node in any mode.
executeQueryAnyMode
  :: forall result
   . ()
  => LocalNodeConnectInfo
  -> QueryInMode (Either EraMismatch result)
  -> ExceptT QueryConvenienceError IO result
executeQueryAnyMode :: forall result.
LocalNodeConnectInfo
-> QueryInMode (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO result
executeQueryAnyMode LocalNodeConnectInfo
localNodeConnInfo QueryInMode (Either EraMismatch result)
q =
  Either QueryConvenienceError result
-> ExceptT QueryConvenienceError IO result
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
    (Either QueryConvenienceError result
 -> ExceptT QueryConvenienceError IO result)
-> (ExceptT AcquiringFailure IO (Either EraMismatch result)
    -> ExceptT
         QueryConvenienceError IO (Either QueryConvenienceError result))
-> ExceptT AcquiringFailure IO (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO result
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Either EraMismatch result -> Either QueryConvenienceError result)
-> ExceptT QueryConvenienceError IO (Either EraMismatch result)
-> ExceptT
     QueryConvenienceError IO (Either QueryConvenienceError result)
forall a b.
(a -> b)
-> ExceptT QueryConvenienceError IO a
-> ExceptT QueryConvenienceError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((EraMismatch -> QueryConvenienceError)
-> Either EraMismatch result -> Either QueryConvenienceError result
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first EraMismatch -> QueryConvenienceError
QueryEraMismatch)
      (ExceptT QueryConvenienceError IO (Either EraMismatch result)
 -> ExceptT
      QueryConvenienceError IO (Either QueryConvenienceError result))
-> (ExceptT AcquiringFailure IO (Either EraMismatch result)
    -> ExceptT QueryConvenienceError IO (Either EraMismatch result))
-> ExceptT AcquiringFailure IO (Either EraMismatch result)
-> ExceptT
     QueryConvenienceError IO (Either QueryConvenienceError result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> QueryConvenienceError)
-> ExceptT QueryConvenienceError IO (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO (Either EraMismatch result)
forall e' (m :: * -> *) e a.
(MonadError e' m, MonadCatch m, Exception e) =>
(e -> e') -> m a -> m a
handleIOExceptionsWith SomeException -> QueryConvenienceError
QceUnexpectedException
      (ExceptT QueryConvenienceError IO (Either EraMismatch result)
 -> ExceptT QueryConvenienceError IO (Either EraMismatch result))
-> (ExceptT AcquiringFailure IO (Either EraMismatch result)
    -> ExceptT QueryConvenienceError IO (Either EraMismatch result))
-> ExceptT AcquiringFailure IO (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO (Either EraMismatch result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AcquiringFailure -> QueryConvenienceError)
-> ExceptT AcquiringFailure IO (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO (Either EraMismatch result)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError AcquiringFailure -> QueryConvenienceError
AcqFailure
    (ExceptT AcquiringFailure IO (Either EraMismatch result)
 -> ExceptT QueryConvenienceError IO result)
-> ExceptT AcquiringFailure IO (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO result
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> QueryInMode (Either EraMismatch result)
-> ExceptT AcquiringFailure IO (Either EraMismatch result)
forall result.
LocalNodeConnectInfo
-> Target ChainPoint
-> QueryInMode result
-> ExceptT AcquiringFailure IO result
queryNodeLocalState LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
forall point. Target point
VolatileTip QueryInMode (Either EraMismatch result)
q