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

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

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

import Cardano.Api.Address
import Cardano.Api.Certificate.Internal
import Cardano.Api.Consensus.Internal.Mode
import Cardano.Api.Era
import Cardano.Api.Error
import Cardano.Api.IO
import Cardano.Api.Monad.Error
import Cardano.Api.Network.IPC
import Cardano.Api.Network.Internal.NetworkId
import Cardano.Api.Pretty
import Cardano.Api.ProtocolParameters
import Cardano.Api.Query.Internal.Expr
import Cardano.Api.Query.Internal.Type.QueryInMode
import Cardano.Api.Tx.Internal.Body
import Cardano.Api.UTxO (UTxO (..))

import Cardano.Ledger.CertState (DRepState (..))
import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Credential qualified as L
import Cardano.Ledger.Keys qualified as L
import Cardano.Ledger.Shelley.LedgerState qualified 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 Data.Map qualified 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

instance Error QueryConvenienceError where
  prettyError :: forall ann. QueryConvenienceError -> Doc ann
prettyError = Text -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow (Text -> Doc ann)
-> (QueryConvenienceError -> Text)
-> QueryConvenienceError
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConvenienceError -> Text
renderQueryConvenienceError

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 NodeToClientVersion
ntcVersion [NodeToClientVersion]
supportedVersions)) =
  Text
"Unsupported feature for the node-to-client protocol version.\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"The negotiated version is "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NodeToClientVersion -> Text
forall a. Show a => a -> Text
textShow NodeToClientVersion
ntcVersion
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but this query is only supported in "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [NodeToClientVersion] -> Text
forall a. Show a => a -> Text
textShow [NodeToClientVersion]
supportedVersions
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Probably either the client or the node is out-of-date.\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Later node versions support later node-to-client 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.Tx.Internal.Convenience.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.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) 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) 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) 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) 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) 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) 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) Coin,
         Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue)))
forall a b. (a -> b) -> a -> b
$ do
  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 = [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 = [Item (Set (Credential 'DRepRole))] -> Set (Credential 'DRepRole)
forall l. IsList l => [Item l] -> l
fromList ([Item (Set (Credential 'DRepRole))] -> Set (Credential 'DRepRole))
-> [Item (Set (Credential 'DRepRole))]
-> Set (Credential 'DRepRole)
forall a b. (a -> b) -> a -> b
$ (Certificate era -> Maybe (Credential 'DRepRole))
-> [Certificate era] -> [Credential 'DRepRole]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Certificate era -> Maybe (Credential 'DRepRole)
forall era. Certificate era -> Maybe (Credential 'DRepRole)
filterUnRegDRepCreds [Certificate era]
certs

  -- Query execution
  utxo <-
    lift (queryUtxo sbe (QueryUTxOByTxIn (fromList allTxIns)))
      & onLeft (left . QceUnsupportedNtcVersion)
      & onLeft (left . QueryEraMismatch)

  pparams <-
    lift (queryProtocolParameters sbe)
      & onLeft (left . QceUnsupportedNtcVersion)
      & onLeft (left . QueryEraMismatch)

  eraHistory <-
    lift queryEraHistory
      & onLeft (left . QceUnsupportedNtcVersion)

  systemStart <-
    lift querySystemStart
      & onLeft (left . QceUnsupportedNtcVersion)

  stakePools <-
    lift (queryStakePools sbe)
      & onLeft (left . QceUnsupportedNtcVersion)
      & onLeft (left . QueryEraMismatch)

  stakeDelegDeposits <-
    monoidForEraInEonA era $ \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)

  drepDelegDeposits <-
    monoidForEraInEonA era $ \ConwayEraOnwards era
con ->
      (DRepState -> Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map DRepState -> Coin
drepDeposit
        (Map (Credential 'DRepRole) DRepState
 -> Map (Credential 'DRepRole) Coin)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map (Credential 'DRepRole) DRepState)
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map (Credential 'DRepRole) 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) DRepState)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
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)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
forall era block point r.
ConwayEraOnwards era
-> Set (Credential 'DRepRole)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
queryDRepState ConwayEraOnwards era
con Set (Credential 'DRepRole)
drepCreds)
                ExceptT
  QueryConvenienceError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map (Credential 'DRepRole) DRepState))
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map (Credential 'DRepRole) DRepState))
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) DRepState))
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) DRepState)))
-> (UnsupportedNtcVersionError -> QueryConvenienceError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map (Credential 'DRepRole) DRepState))
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) DRepState))
-> (ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either EraMismatch (Map (Credential 'DRepRole) DRepState))
    -> ExceptT
         QueryConvenienceError
         (LocalStateQueryExpr block point QueryInMode r IO)
         (Map (Credential 'DRepRole) DRepState))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map (Credential 'DRepRole) DRepState)
forall a b. a -> (a -> b) -> b
& (EraMismatch
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Map (Credential 'DRepRole) DRepState))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either EraMismatch (Map (Credential 'DRepRole) DRepState))
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map (Credential 'DRepRole) DRepState)
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) DRepState)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryConvenienceError
 -> ExceptT
      QueryConvenienceError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Map (Credential 'DRepRole) DRepState))
-> (EraMismatch -> QueryConvenienceError)
-> EraMismatch
-> ExceptT
     QueryConvenienceError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Map (Credential 'DRepRole) DRepState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryConvenienceError
QueryEraMismatch)
            )

  featuredTxTreasuryValueM <-
    caseShelleyToBabbageOrConwayEraOnwards
      (const $ pure Nothing)
      ( \ConwayEraOnwards era
cOnwards -> do
          L.AccountState{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 = Coin -> TxCurrentTreasuryValue
TxCurrentTreasuryValue Coin
asTreasury
          return $ Just $ Featured cOnwards txCurrentTreasuryValue
      )
      sbe

  pure
    ( utxo
    , LedgerProtocolParameters pparams
    , eraHistory
    , systemStart
    , stakePools
    , stakeDelegDeposits
    , drepDelegDeposits
    , 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