-- | A basic cardano-node client that can talk to a local cardano-node.
--
-- The idea of this module is to provide a Haskell interface on top of
-- cardano-cli's API, using cardano-api types.
module Hydra.Chain.CardanoClient where

import Hydra.Prelude

import Hydra.Cardano.Api hiding (Block, queryCurrentEra)

import Cardano.Api.UTxO qualified as UTxO
import Data.Set qualified as Set
import Text.Printf (printf)

-- XXX: This should be re-exported by cardano-api
-- https://github.com/IntersectMBO/cardano-api/issues/447

data QueryException
  = QueryAcquireException AcquiringFailure
  | QueryEraMismatchException EraMismatch
  | QueryUnsupportedNtcVersionException UnsupportedNtcVersionError
  | QueryProtocolParamsConversionException ProtocolParametersConversionError
  | QueryProtocolParamsEraNotSupported AnyCardanoEra
  | QueryProtocolParamsEncodingFailureOnEra AnyCardanoEra Text
  | QueryEraNotInCardanoModeFailure AnyCardanoEra
  | QueryNotShelleyBasedEraException AnyCardanoEra
  | QueryNotConwayEraOnwardsException AnyCardanoEra
  deriving stock (Int -> QueryException -> ShowS
[QueryException] -> ShowS
QueryException -> String
(Int -> QueryException -> ShowS)
-> (QueryException -> String)
-> ([QueryException] -> ShowS)
-> Show QueryException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryException -> ShowS
showsPrec :: Int -> QueryException -> ShowS
$cshow :: QueryException -> String
show :: QueryException -> String
$cshowList :: [QueryException] -> ShowS
showList :: [QueryException] -> ShowS
Show, QueryException -> QueryException -> Bool
(QueryException -> QueryException -> Bool)
-> (QueryException -> QueryException -> Bool) -> Eq QueryException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryException -> QueryException -> Bool
== :: QueryException -> QueryException -> Bool
$c/= :: QueryException -> QueryException -> Bool
/= :: QueryException -> QueryException -> Bool
Eq)

instance Exception QueryException where
  displayException :: QueryException -> String
displayException = \case
    QueryAcquireException AcquiringFailure
failure -> AcquiringFailure -> String
forall b a. (Show a, IsString b) => a -> b
show AcquiringFailure
failure
    QueryEraMismatchException EraMismatch{Text
ledgerEraName :: Text
ledgerEraName :: EraMismatch -> Text
ledgerEraName, Text
otherEraName :: Text
otherEraName :: EraMismatch -> Text
otherEraName} ->
      -- NOTE: The "ledger" here is the one in the cardano-node and "otherEra" is the one we picked for the query.
      String -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Connected to cardano-node in unsupported era %s, while we requested %s. Please upgrade your hydra-node." Text
ledgerEraName Text
otherEraName
    QueryUnsupportedNtcVersionException UnsupportedNtcVersionError
err -> UnsupportedNtcVersionError -> String
forall b a. (Show a, IsString b) => a -> b
show UnsupportedNtcVersionError
err
    QueryProtocolParamsConversionException ProtocolParametersConversionError
err -> ProtocolParametersConversionError -> String
forall b a. (Show a, IsString b) => a -> b
show ProtocolParametersConversionError
err
    QueryProtocolParamsEraNotSupported AnyCardanoEra
unsupportedEraName ->
      String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Error while querying protocol params using era %s." (AnyCardanoEra -> Text
forall b a. (Show a, IsString b) => a -> b
show AnyCardanoEra
unsupportedEraName :: Text)
    QueryProtocolParamsEncodingFailureOnEra AnyCardanoEra
eraName Text
encodingFailure ->
      String -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Error while querying protocol params using era %s: %s." (AnyCardanoEra -> Text
forall b a. (Show a, IsString b) => a -> b
show AnyCardanoEra
eraName :: Text) Text
encodingFailure
    QueryEraNotInCardanoModeFailure AnyCardanoEra
eraName ->
      String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Error while querying using era %s not in cardano mode." (AnyCardanoEra -> Text
forall b a. (Show a, IsString b) => a -> b
show AnyCardanoEra
eraName :: Text)
    QueryNotShelleyBasedEraException AnyCardanoEra
eraName ->
      String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Error while querying using era %s not in shelley based era." (AnyCardanoEra -> Text
forall b a. (Show a, IsString b) => a -> b
show AnyCardanoEra
eraName :: Text)
    QueryNotConwayEraOnwardsException AnyCardanoEra
eraName ->
      String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Error while querying using era %s not in conway based era." (AnyCardanoEra -> Text
forall b a. (Show a, IsString b) => a -> b
show AnyCardanoEra
eraName :: Text)

-- * CardanoClient handle

-- | Handle interface for abstract querying of a cardano node.
data CardanoClient = CardanoClient
  { CardanoClient -> [Address ShelleyAddr] -> IO UTxO
queryUTxOByAddress :: [Address ShelleyAddr] -> IO UTxO
  , CardanoClient -> NetworkId
networkId :: NetworkId
  }

-- * Tx Construction / Submission

-- | Submit a (signed) transaction to the node.
--
-- Throws 'SubmitTransactionException' if submission fails.
submitTransaction ::
  LocalNodeConnectInfo ->
  -- | A signed transaction.
  Tx ->
  IO ()
submitTransaction :: LocalNodeConnectInfo -> Tx -> IO ()
submitTransaction LocalNodeConnectInfo
connectInfo Tx
tx =
  LocalNodeConnectInfo -> TxInMode -> IO TxSubmitResult
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LocalNodeConnectInfo -> TxInMode -> m TxSubmitResult
submitTxToNodeLocal LocalNodeConnectInfo
connectInfo TxInMode
txInMode IO TxSubmitResult -> (TxSubmitResult -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TxSubmitResult
TxSubmitSuccess ->
      () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TxSubmitFail (TxValidationEraMismatch EraMismatch
e) ->
      SubmitTransactionException -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (EraMismatch -> SubmitTransactionException
SubmitEraMismatch EraMismatch
e)
    TxSubmitFail e :: TxValidationErrorInCardanoMode
e@TxValidationErrorInCardanoMode{} ->
      SubmitTransactionException -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (TxValidationErrorInCardanoMode -> SubmitTransactionException
SubmitTxValidationError TxValidationErrorInCardanoMode
e)
    TxSubmitError SomeException
e ->
      SomeException -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e
 where
  txInMode :: TxInMode
txInMode =
    ShelleyBasedEra Era -> Tx -> TxInMode
forall era. ShelleyBasedEra era -> Tx era -> TxInMode
TxInMode ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra Tx
tx

-- | Exceptions that 'can' occur during a transaction submission.
--
-- In principle, we can only encounter an 'EraMismatch' at era boundaries, when
-- we try to submit a "next era" transaction as a "current era" transaction, or
-- vice-versa.
-- Similarly, 'TxValidationError' shouldn't occur given that the transaction was
-- safely constructed through 'buildTransaction'.
data SubmitTransactionException
  = SubmitEraMismatch EraMismatch
  | SubmitTxValidationError TxValidationErrorInCardanoMode
  deriving stock (Int -> SubmitTransactionException -> ShowS
[SubmitTransactionException] -> ShowS
SubmitTransactionException -> String
(Int -> SubmitTransactionException -> ShowS)
-> (SubmitTransactionException -> String)
-> ([SubmitTransactionException] -> ShowS)
-> Show SubmitTransactionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitTransactionException -> ShowS
showsPrec :: Int -> SubmitTransactionException -> ShowS
$cshow :: SubmitTransactionException -> String
show :: SubmitTransactionException -> String
$cshowList :: [SubmitTransactionException] -> ShowS
showList :: [SubmitTransactionException] -> ShowS
Show)

instance Exception SubmitTransactionException

-- | Await until the given transaction is visible on-chain. Returns the UTxO
-- set produced by that transaction.
--
-- Note that this function loops forever; hence, one probably wants to couple it
-- with a surrounding timeout.
awaitTransaction ::
  LocalNodeConnectInfo ->
  -- | The transaction to watch / await
  Tx ->
  IO UTxO
awaitTransaction :: LocalNodeConnectInfo -> Tx -> IO UTxO
awaitTransaction LocalNodeConnectInfo
connectInfo Tx
tx = do
  DiffTime
pollInterval <- NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> DiffTime) -> IO NominalDiffTime -> IO DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalNodeConnectInfo -> QueryPoint -> IO NominalDiffTime
queryBlockTime LocalNodeConnectInfo
connectInfo QueryPoint
QueryTip
  DiffTime -> IO UTxO
go DiffTime
pollInterval
 where
  ins :: [TxIn]
ins = Map TxIn (TxOut CtxUTxO Era) -> [TxIn]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [a]
keys (UTxO -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
UTxO.toMap (UTxO -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO -> Map TxIn (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ Tx -> UTxO
utxoFromTx Tx
tx)
  go :: DiffTime -> IO UTxO
go DiffTime
pollInterval = do
    UTxO
utxo <- LocalNodeConnectInfo -> QueryPoint -> [TxIn] -> IO UTxO
queryUTxOByTxIn LocalNodeConnectInfo
connectInfo QueryPoint
QueryTip [TxIn]
ins
    if UTxO -> Bool
forall era. UTxO era -> Bool
UTxO.null UTxO
utxo
      then DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
pollInterval IO () -> IO UTxO -> IO UTxO
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiffTime -> IO UTxO
go DiffTime
pollInterval
      else UTxO -> IO UTxO
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTxO
utxo

-- * Local state query

-- | Describes whether to query at the tip or at a specific point.
data QueryPoint = QueryTip | QueryAt ChainPoint
  deriving stock (QueryPoint -> QueryPoint -> Bool
(QueryPoint -> QueryPoint -> Bool)
-> (QueryPoint -> QueryPoint -> Bool) -> Eq QueryPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryPoint -> QueryPoint -> Bool
== :: QueryPoint -> QueryPoint -> Bool
$c/= :: QueryPoint -> QueryPoint -> Bool
/= :: QueryPoint -> QueryPoint -> Bool
Eq, Int -> QueryPoint -> ShowS
[QueryPoint] -> ShowS
QueryPoint -> String
(Int -> QueryPoint -> ShowS)
-> (QueryPoint -> String)
-> ([QueryPoint] -> ShowS)
-> Show QueryPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryPoint -> ShowS
showsPrec :: Int -> QueryPoint -> ShowS
$cshow :: QueryPoint -> String
show :: QueryPoint -> String
$cshowList :: [QueryPoint] -> ShowS
showList :: [QueryPoint] -> ShowS
Show, (forall x. QueryPoint -> Rep QueryPoint x)
-> (forall x. Rep QueryPoint x -> QueryPoint) -> Generic QueryPoint
forall x. Rep QueryPoint x -> QueryPoint
forall x. QueryPoint -> Rep QueryPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QueryPoint -> Rep QueryPoint x
from :: forall x. QueryPoint -> Rep QueryPoint x
$cto :: forall x. Rep QueryPoint x -> QueryPoint
to :: forall x. Rep QueryPoint x -> QueryPoint
Generic)

-- | Query the latest chain point aka "the tip".
queryTip :: LocalNodeConnectInfo -> IO ChainPoint
queryTip :: LocalNodeConnectInfo -> IO ChainPoint
queryTip LocalNodeConnectInfo
connectInfo =
  ChainTip -> ChainPoint
chainTipToChainPoint (ChainTip -> ChainPoint) -> IO ChainTip -> IO ChainPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalNodeConnectInfo -> IO ChainTip
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo -> m ChainTip
getLocalChainTip LocalNodeConnectInfo
connectInfo

-- | Query the system start parameter at given point.
--
-- Throws at least 'QueryException' if query fails.
querySystemStart :: LocalNodeConnectInfo -> QueryPoint -> IO SystemStart
querySystemStart :: LocalNodeConnectInfo -> QueryPoint -> IO SystemStart
querySystemStart LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint =
  LocalNodeConnectInfo
-> QueryPoint -> QueryInMode SystemStart -> IO SystemStart
forall a.
LocalNodeConnectInfo -> QueryPoint -> QueryInMode a -> IO a
runQuery LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint QueryInMode SystemStart
QuerySystemStart

-- | Query the era history at given point.
--
-- Throws at least 'QueryException' if query fails.
queryEraHistory :: LocalNodeConnectInfo -> QueryPoint -> IO EraHistory
queryEraHistory :: LocalNodeConnectInfo -> QueryPoint -> IO EraHistory
queryEraHistory LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint =
  LocalNodeConnectInfo
-> QueryPoint -> QueryInMode EraHistory -> IO EraHistory
forall a.
LocalNodeConnectInfo -> QueryPoint -> QueryInMode a -> IO a
runQuery LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint QueryInMode EraHistory
QueryEraHistory

-- | Query the protocol parameters at given point.
--
-- Throws at least 'QueryException' if query fails.
queryProtocolParameters ::
  LocalNodeConnectInfo ->
  QueryPoint ->
  IO (PParams LedgerEra)
queryProtocolParameters :: LocalNodeConnectInfo -> QueryPoint -> IO (PParams LedgerEra)
queryProtocolParameters LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint =
  LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra)
-> IO (PParams LedgerEra)
forall a.
LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra)
 -> IO (PParams LedgerEra))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra)
-> IO (PParams LedgerEra)
forall a b. (a -> b) -> a -> b
$
    (forall era.
 ConwayEraOnwards era
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra)
forall (eon :: * -> *) b p r a.
Eon eon =>
(forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInConwayEraOnwardsExpr ((forall era.
  ConwayEraOnwards era
  -> LocalStateQueryExpr
       BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra))
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra))
-> (forall era.
    ConwayEraOnwards era
    -> LocalStateQueryExpr
         BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra)
forall a b. (a -> b) -> a -> b
$ \(ConwayEraOnwards era
ceo :: ConwayEraOnwards era) -> case ConwayEraOnwards era
ceo of
      ConwayEraOnwards era
ConwayEraOnwardsConway ->
        ShelleyBasedEra era
-> QueryInShelleyBasedEra era (PParams ConwayEra)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams ConwayEra)
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr (ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
ceo) QueryInShelleyBasedEra era (PParams ConwayEra)
QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
QueryProtocolParameters
      ConwayEraOnwards era
ConwayEraOnwardsDijkstra ->
        Text
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams ConwayEra)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Dijkstra era not supported"

-- | Query 'GenesisParameters' at a given point.
--
-- Throws at least 'QueryException' if query fails.
queryGenesisParameters ::
  LocalNodeConnectInfo ->
  QueryPoint ->
  IO (GenesisParameters ShelleyEra)
queryGenesisParameters :: LocalNodeConnectInfo
-> QueryPoint -> IO (GenesisParameters ShelleyEra)
queryGenesisParameters LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint =
  LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (GenesisParameters ShelleyEra)
-> IO (GenesisParameters ShelleyEra)
forall a.
LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (GenesisParameters ShelleyEra)
 -> IO (GenesisParameters ShelleyEra))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (GenesisParameters ShelleyEra)
-> IO (GenesisParameters ShelleyEra)
forall a b. (a -> b) -> a -> b
$ do
    (forall era.
 ShelleyBasedEra era
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (GenesisParameters ShelleyEra))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (GenesisParameters ShelleyEra)
forall b p r a.
(forall era.
 ShelleyBasedEra era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInShelleyBasedEraExpr (ShelleyBasedEra era
-> QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (GenesisParameters ShelleyEra)
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
`queryInShelleyBasedEraExpr` QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
forall era.
QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
QueryGenesisParameters)

-- | Query the chain's average block time, derived from genesis parameters as
-- 'protocolParamSlotLength' / 'protocolParamActiveSlotsCoefficient'.
--
-- Throws at least 'QueryException' if query fails.
queryBlockTime :: LocalNodeConnectInfo -> QueryPoint -> IO NominalDiffTime
queryBlockTime :: LocalNodeConnectInfo -> QueryPoint -> IO NominalDiffTime
queryBlockTime LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint = do
  GenesisParameters{Rational
protocolParamActiveSlotsCoefficient :: forall era. GenesisParameters era -> Rational
protocolParamActiveSlotsCoefficient :: Rational
protocolParamActiveSlotsCoefficient, NominalDiffTime
protocolParamSlotLength :: forall era. GenesisParameters era -> NominalDiffTime
protocolParamSlotLength :: NominalDiffTime
protocolParamSlotLength} <-
    LocalNodeConnectInfo
-> QueryPoint -> IO (GenesisParameters ShelleyEra)
Hydra.Chain.CardanoClient.queryGenesisParameters LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint
  NominalDiffTime -> IO NominalDiffTime
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalDiffTime -> IO NominalDiffTime)
-> NominalDiffTime -> IO NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Rational -> NominalDiffTime
computeBlockTime NominalDiffTime
protocolParamSlotLength Rational
protocolParamActiveSlotsCoefficient

-- | Compute the block time (expected time between blocks) given a slot length
-- and active slot coefficient.
computeBlockTime :: NominalDiffTime -> Rational -> NominalDiffTime
computeBlockTime :: NominalDiffTime -> Rational -> NominalDiffTime
computeBlockTime NominalDiffTime
slotLength Rational
activeSlotsCoeff =
  NominalDiffTime
slotLength NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ Rational -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
activeSlotsCoeff

-- | Query UTxO for all given addresses at given point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxO :: LocalNodeConnectInfo -> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
queryUTxO :: LocalNodeConnectInfo
-> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
queryUTxO LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint [Address ShelleyAddr]
addresses =
  LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
-> IO UTxO
forall a.
LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO UTxO
 -> IO UTxO)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
-> IO UTxO
forall a b. (a -> b) -> a -> b
$
    (forall era.
 ConwayEraOnwards era
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO UTxO)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall (eon :: * -> *) b p r a.
Eon eon =>
(forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInConwayEraOnwardsExpr ((forall era.
  ConwayEraOnwards era
  -> LocalStateQueryExpr
       BlockInMode ChainPoint QueryInMode () IO UTxO)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO UTxO)
-> (forall era.
    ConwayEraOnwards era
    -> LocalStateQueryExpr
         BlockInMode ChainPoint QueryInMode () IO UTxO)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall a b. (a -> b) -> a -> b
$ \(ConwayEraOnwards era
ceo :: ConwayEraOnwards era) -> case ConwayEraOnwards era
ceo of
      ConwayEraOnwards era
ConwayEraOnwardsConway ->
        ShelleyBasedEra era
-> QueryInShelleyBasedEra era UTxO
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr (ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
ceo) (QueryInShelleyBasedEra era UTxO
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO UTxO)
-> QueryInShelleyBasedEra era UTxO
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall a b. (a -> b) -> a -> b
$
          QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO (Set AddressAny -> QueryUTxOFilter
QueryUTxOByAddress ([AddressAny] -> Set AddressAny
forall a. Ord a => [a] -> Set a
Set.fromList ([AddressAny] -> Set AddressAny) -> [AddressAny] -> Set AddressAny
forall a b. (a -> b) -> a -> b
$ (Address ShelleyAddr -> AddressAny)
-> [Address ShelleyAddr] -> [AddressAny]
forall a b. (a -> b) -> [a] -> [b]
map Address ShelleyAddr -> AddressAny
AddressShelley [Address ShelleyAddr]
addresses))
      ConwayEraOnwards era
ConwayEraOnwardsDijkstra ->
        Text
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Dijkstra era not supported"

-- | Query UTxO for given tx inputs at given point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxOByTxIn ::
  LocalNodeConnectInfo ->
  QueryPoint ->
  [TxIn] ->
  IO UTxO
queryUTxOByTxIn :: LocalNodeConnectInfo -> QueryPoint -> [TxIn] -> IO UTxO
queryUTxOByTxIn LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint [TxIn]
inputs =
  LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
-> IO UTxO
forall a.
LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO UTxO
 -> IO UTxO)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
-> IO UTxO
forall a b. (a -> b) -> a -> b
$
    (forall era.
 ConwayEraOnwards era
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO UTxO)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall (eon :: * -> *) b p r a.
Eon eon =>
(forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInConwayEraOnwardsExpr
      ( \(ConwayEraOnwards era
ceo :: ConwayEraOnwards era) -> case ConwayEraOnwards era
ceo of
          ConwayEraOnwards era
ConwayEraOnwardsConway -> ShelleyBasedEra era
-> QueryInShelleyBasedEra era UTxO
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr (ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
ceo) (QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO (Set TxIn -> QueryUTxOFilter
QueryUTxOByTxIn ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
inputs)))
          ConwayEraOnwards era
ConwayEraOnwardsDijkstra -> Text
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Dijkstra era not supported"
      )

queryForCurrentEraInEonExpr ::
  Eon eon =>
  (AnyCardanoEra -> IO a) ->
  (forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a) ->
  LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInEonExpr :: forall (eon :: * -> *) a b p r.
Eon eon =>
(AnyCardanoEra -> IO a)
-> (forall era.
    eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInEonExpr AnyCardanoEra -> IO a
no forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a
yes = do
  k :: AnyCardanoEra
k@(AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr
  LocalStateQueryExpr b p QueryInMode r IO a
-> (eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> CardanoEra era
-> LocalStateQueryExpr b p QueryInMode r IO a
forall a era. a -> (eon era -> a) -> CardanoEra era -> a
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> CardanoEra era -> a
inEonForEra (IO a -> LocalStateQueryExpr b p QueryInMode r IO a
forall a. IO a -> LocalStateQueryExpr b p QueryInMode r IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> LocalStateQueryExpr b p QueryInMode r IO a)
-> IO a -> LocalStateQueryExpr b p QueryInMode r IO a
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> IO a
no AnyCardanoEra
k) eon era -> LocalStateQueryExpr b p QueryInMode r IO a
forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a
yes CardanoEra era
era

queryForCurrentEraInShelleyBasedEraExpr ::
  (forall era. ShelleyBasedEra era -> LocalStateQueryExpr b p QueryInMode r IO a) ->
  LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInShelleyBasedEraExpr :: forall b p r a.
(forall era.
 ShelleyBasedEra era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInShelleyBasedEraExpr = (AnyCardanoEra -> IO a)
-> (forall {era}.
    ShelleyBasedEra era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
forall (eon :: * -> *) a b p r.
Eon eon =>
(AnyCardanoEra -> IO a)
-> (forall era.
    eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInEonExpr (QueryException -> IO a
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> IO a)
-> (AnyCardanoEra -> QueryException) -> AnyCardanoEra -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> QueryException
QueryNotShelleyBasedEraException)

queryForCurrentEraInConwayEraOnwardsExpr ::
  Eon eon =>
  (forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a) ->
  LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInConwayEraOnwardsExpr :: forall (eon :: * -> *) b p r a.
Eon eon =>
(forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInConwayEraOnwardsExpr = (AnyCardanoEra -> IO a)
-> (forall {era}.
    eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
forall (eon :: * -> *) a b p r.
Eon eon =>
(AnyCardanoEra -> IO a)
-> (forall era.
    eon era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInEonExpr (QueryException -> IO a
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> IO a)
-> (AnyCardanoEra -> QueryException) -> AnyCardanoEra -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> QueryException
QueryNotConwayEraOnwardsException)

-- | Query UTxO for the address of given verification key at point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxOFor :: LocalNodeConnectInfo -> QueryPoint -> VerificationKey PaymentKey -> IO UTxO
queryUTxOFor :: LocalNodeConnectInfo
-> QueryPoint -> VerificationKey PaymentKey -> IO UTxO
queryUTxOFor LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint VerificationKey PaymentKey
vk =
  case NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress (LocalNodeConnectInfo -> NetworkId
localNodeNetworkId LocalNodeConnectInfo
connectInfo) VerificationKey PaymentKey
vk of
    ShelleyAddressInEra Address ShelleyAddr
addr ->
      LocalNodeConnectInfo
-> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
queryUTxO LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint [Address ShelleyAddr
addr]
    ByronAddressInEra{} ->
      Text -> IO UTxO
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"impossible: mkVkAddress returned Byron address."

-- | Query the current set of registered stake pools.
--
-- Throws at least 'QueryException' if query fails.
queryStakePools ::
  LocalNodeConnectInfo ->
  QueryPoint ->
  IO (Set PoolId)
queryStakePools :: LocalNodeConnectInfo -> QueryPoint -> IO (Set PoolId)
queryStakePools LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint =
  LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Set PoolId)
-> IO (Set PoolId)
forall a.
LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr LocalNodeConnectInfo
connectInfo QueryPoint
queryPoint (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Set PoolId)
 -> IO (Set PoolId))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Set PoolId)
-> IO (Set PoolId)
forall a b. (a -> b) -> a -> b
$ do
    (forall era.
 ShelleyBasedEra era
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Set PoolId))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Set PoolId)
forall b p r a.
(forall era.
 ShelleyBasedEra era -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInShelleyBasedEraExpr (ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Set PoolId)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Set PoolId)
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
`queryInShelleyBasedEraExpr` QueryInShelleyBasedEra era (Set PoolId)
forall era. QueryInShelleyBasedEra era (Set PoolId)
QueryStakePools)

-- * Helpers

-- | Monadic query expression to get current era.
queryCurrentEraExpr :: LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr :: forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr =
  QueryInMode AnyCardanoEra
-> LocalStateQueryExpr
     b
     p
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError AnyCardanoEra)
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr QueryInMode AnyCardanoEra
QueryCurrentEra LocalStateQueryExpr
  b
  p
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> (Either UnsupportedNtcVersionError AnyCardanoEra
    -> LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra)
-> LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
forall a b.
LocalStateQueryExpr b p QueryInMode r IO a
-> (a -> LocalStateQueryExpr b p QueryInMode r IO b)
-> LocalStateQueryExpr b p QueryInMode r IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO AnyCardanoEra
-> LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
forall a. IO a -> LocalStateQueryExpr b p QueryInMode r IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra
 -> LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra)
-> (Either UnsupportedNtcVersionError AnyCardanoEra
    -> IO AnyCardanoEra)
-> Either UnsupportedNtcVersionError AnyCardanoEra
-> LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either UnsupportedNtcVersionError AnyCardanoEra -> IO AnyCardanoEra
forall (m :: * -> *) a.
MonadThrow m =>
Either UnsupportedNtcVersionError a -> m a
throwOnUnsupportedNtcVersion

-- | Monadic query expression for a 'QueryInShelleyBasedEra'.
queryInShelleyBasedEraExpr ::
  -- | The current running era we can use to query the node
  ShelleyBasedEra era ->
  QueryInShelleyBasedEra era a ->
  LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr :: forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr ShelleyBasedEra era
sbe QueryInShelleyBasedEra era a
query =
  QueryInMode (Either EraMismatch a)
-> LocalStateQueryExpr
     b
     p
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
forall a block point r.
QueryInMode a
-> LocalStateQueryExpr
     block point QueryInMode r IO (Either UnsupportedNtcVersionError a)
queryExpr (QueryInEra era a -> QueryInMode (Either EraMismatch a)
forall era result1.
QueryInEra era result1 -> QueryInMode (Either EraMismatch result1)
QueryInEra (QueryInEra era a -> QueryInMode (Either EraMismatch a))
-> QueryInEra era a -> QueryInMode (Either EraMismatch a)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era a -> QueryInEra era a
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era a
query)
    LocalStateQueryExpr
  b
  p
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> (Either UnsupportedNtcVersionError (Either EraMismatch a)
    -> LocalStateQueryExpr b p QueryInMode r IO (Either EraMismatch a))
-> LocalStateQueryExpr b p QueryInMode r IO (Either EraMismatch a)
forall a b.
LocalStateQueryExpr b p QueryInMode r IO a
-> (a -> LocalStateQueryExpr b p QueryInMode r IO b)
-> LocalStateQueryExpr b p QueryInMode r IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Either EraMismatch a)
-> LocalStateQueryExpr b p QueryInMode r IO (Either EraMismatch a)
forall a. IO a -> LocalStateQueryExpr b p QueryInMode r IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Either EraMismatch a)
 -> LocalStateQueryExpr b p QueryInMode r IO (Either EraMismatch a))
-> (Either UnsupportedNtcVersionError (Either EraMismatch a)
    -> IO (Either EraMismatch a))
-> Either UnsupportedNtcVersionError (Either EraMismatch a)
-> LocalStateQueryExpr b p QueryInMode r IO (Either EraMismatch a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either UnsupportedNtcVersionError (Either EraMismatch a)
-> IO (Either EraMismatch a)
forall (m :: * -> *) a.
MonadThrow m =>
Either UnsupportedNtcVersionError a -> m a
throwOnUnsupportedNtcVersion
    LocalStateQueryExpr b p QueryInMode r IO (Either EraMismatch a)
-> (Either EraMismatch a
    -> LocalStateQueryExpr b p QueryInMode r IO a)
-> LocalStateQueryExpr b p QueryInMode r IO a
forall a b.
LocalStateQueryExpr b p QueryInMode r IO a
-> (a -> LocalStateQueryExpr b p QueryInMode r IO b)
-> LocalStateQueryExpr b p QueryInMode r IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> LocalStateQueryExpr b p QueryInMode r IO a
forall a. IO a -> LocalStateQueryExpr b p QueryInMode r IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO a -> LocalStateQueryExpr b p QueryInMode r IO a)
-> (Either EraMismatch a -> IO a)
-> Either EraMismatch a
-> LocalStateQueryExpr b p QueryInMode r IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either EraMismatch a -> IO a
forall (m :: * -> *) a. MonadThrow m => Either EraMismatch a -> m a
throwOnEraMismatch

-- | Throws at least 'QueryException' if query fails.
runQuery :: LocalNodeConnectInfo -> QueryPoint -> QueryInMode a -> IO a
runQuery :: forall a.
LocalNodeConnectInfo -> QueryPoint -> QueryInMode a -> IO a
runQuery LocalNodeConnectInfo
connectInfo QueryPoint
point QueryInMode a
query =
  ExceptT AcquiringFailure IO a -> IO (Either AcquiringFailure a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (LocalNodeConnectInfo
-> Target ChainPoint
-> QueryInMode a
-> ExceptT AcquiringFailure IO a
forall result.
LocalNodeConnectInfo
-> Target ChainPoint
-> QueryInMode result
-> ExceptT AcquiringFailure IO result
queryNodeLocalState LocalNodeConnectInfo
connectInfo Target ChainPoint
queryTarget QueryInMode a
query) IO (Either AcquiringFailure a)
-> (Either AcquiringFailure a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left AcquiringFailure
err -> QueryException -> IO a
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> IO a) -> QueryException -> IO a
forall a b. (a -> b) -> a -> b
$ AcquiringFailure -> QueryException
QueryAcquireException AcquiringFailure
err
    Right a
result -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
 where
  queryTarget :: Target ChainPoint
queryTarget =
    case QueryPoint
point of
      QueryPoint
QueryTip -> Target ChainPoint
forall point. Target point
VolatileTip
      QueryAt ChainPoint
cp -> ChainPoint -> Target ChainPoint
forall point. point -> Target point
SpecificPoint ChainPoint
cp

-- | Throws at least 'QueryException' if query fails.
runQueryExpr ::
  LocalNodeConnectInfo ->
  QueryPoint ->
  LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a ->
  IO a
runQueryExpr :: forall a.
LocalNodeConnectInfo
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr LocalNodeConnectInfo
connectInfo QueryPoint
point LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
query =
  LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
connectInfo Target ChainPoint
queryTarget LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
query IO (Either AcquiringFailure a)
-> (Either AcquiringFailure a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left AcquiringFailure
err -> QueryException -> IO a
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> IO a) -> QueryException -> IO a
forall a b. (a -> b) -> a -> b
$ AcquiringFailure -> QueryException
QueryAcquireException AcquiringFailure
err
    Right a
result -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
 where
  queryTarget :: Target ChainPoint
queryTarget =
    case QueryPoint
point of
      QueryPoint
QueryTip -> Target ChainPoint
forall point. Target point
VolatileTip
      QueryAt ChainPoint
cp -> ChainPoint -> Target ChainPoint
forall point. point -> Target point
SpecificPoint ChainPoint
cp

throwOnEraMismatch :: MonadThrow m => Either EraMismatch a -> m a
throwOnEraMismatch :: forall (m :: * -> *) a. MonadThrow m => Either EraMismatch a -> m a
throwOnEraMismatch Either EraMismatch a
res =
  case Either EraMismatch a
res of
    Left EraMismatch
eraMismatch -> QueryException -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> m a) -> QueryException -> m a
forall a b. (a -> b) -> a -> b
$ EraMismatch -> QueryException
QueryEraMismatchException EraMismatch
eraMismatch
    Right a
result -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

throwOnUnsupportedNtcVersion :: MonadThrow m => Either UnsupportedNtcVersionError a -> m a
throwOnUnsupportedNtcVersion :: forall (m :: * -> *) a.
MonadThrow m =>
Either UnsupportedNtcVersionError a -> m a
throwOnUnsupportedNtcVersion Either UnsupportedNtcVersionError a
res =
  case Either UnsupportedNtcVersionError a
res of
    Left UnsupportedNtcVersionError
unsupportedNtcVersion -> QueryException -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> m a) -> QueryException -> m a
forall a b. (a -> b) -> a -> b
$ UnsupportedNtcVersionError -> QueryException
QueryUnsupportedNtcVersionException UnsupportedNtcVersionError
unsupportedNtcVersion
    Right a
result -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

localNodeConnectInfo :: NetworkId -> SocketPath -> LocalNodeConnectInfo
localNodeConnectInfo :: NetworkId -> SocketPath -> LocalNodeConnectInfo
localNodeConnectInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
cardanoModeParams

cardanoModeParams :: ConsensusModeParams
cardanoModeParams :: ConsensusModeParams
cardanoModeParams = EpochSlots -> ConsensusModeParams
CardanoModeParams (EpochSlots -> ConsensusModeParams)
-> EpochSlots -> ConsensusModeParams
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochSlots
EpochSlots Word64
defaultByronEpochSlots
 where
  -- NOTE(AB): extracted from Parsers in cardano-cli, this is needed to run in 'cardanoMode' which
  -- is the default for cardano-cli
  defaultByronEpochSlots :: Word64
defaultByronEpochSlots = Word64
21600 :: Word64