-- | 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.Aeson (eitherDecode', encode)
import Data.Set qualified as Set
import Data.Text qualified as Text
import Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
import Test.QuickCheck (oneof)
import Text.Printf (printf)

-- XXX: This should be re-exported by cardano-api
-- https://github.com/IntersectMBO/cardano-api/issues/447
import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..))

data QueryException
  = QueryAcquireException AcquiringFailure
  | QueryEraMismatchException EraMismatch
  | QueryProtocolParamsConversionException ProtocolParametersConversionError
  | QueryProtocolParamsEraNotSupported AnyCardanoEra
  | QueryProtocolParamsEncodingFailureOnEra AnyCardanoEra Text
  | QueryEraNotInCardanoModeFailure AnyCardanoEra
  | QueryNotShelleyBasedEraException 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)

instance Eq QueryException where
  QueryException
a == :: QueryException -> QueryException -> Bool
== QueryException
b = case (QueryException
a, QueryException
b) of
    (QueryAcquireException AcquiringFailure
af1, QueryAcquireException AcquiringFailure
af2) -> case (AcquiringFailure
af1, AcquiringFailure
af2) of
      (AcquiringFailure
AFPointTooOld, AcquiringFailure
AFPointTooOld) -> Bool
True
      (AcquiringFailure
AFPointNotOnChain, AcquiringFailure
AFPointNotOnChain) -> Bool
True
      (AcquiringFailure, AcquiringFailure)
_ -> Bool
False
    (QueryEraMismatchException EraMismatch
em1, QueryEraMismatchException EraMismatch
em2) -> EraMismatch
em1 EraMismatch -> EraMismatch -> Bool
forall a. Eq a => a -> a -> Bool
== EraMismatch
em2
    (QueryProtocolParamsEraNotSupported AnyCardanoEra
ens1, QueryProtocolParamsEraNotSupported AnyCardanoEra
ens2) -> AnyCardanoEra
ens1 AnyCardanoEra -> AnyCardanoEra -> Bool
forall a. Eq a => a -> a -> Bool
== AnyCardanoEra
ens2
    (QueryProtocolParamsEncodingFailureOnEra AnyCardanoEra
e1 Text
f1, QueryProtocolParamsEncodingFailureOnEra AnyCardanoEra
e2 Text
f2) -> AnyCardanoEra
e1 AnyCardanoEra -> AnyCardanoEra -> Bool
forall a. Eq a => a -> a -> Bool
== AnyCardanoEra
e2 Bool -> Bool -> Bool
&& Text
f1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
f2
    (QueryEraNotInCardanoModeFailure AnyCardanoEra
e1, QueryEraNotInCardanoModeFailure AnyCardanoEra
e2) -> AnyCardanoEra
e1 AnyCardanoEra -> AnyCardanoEra -> Bool
forall a. Eq a => a -> a -> Bool
== AnyCardanoEra
e2
    (QueryNotShelleyBasedEraException AnyCardanoEra
e1, QueryNotShelleyBasedEraException AnyCardanoEra
e2) -> AnyCardanoEra
e1 AnyCardanoEra -> AnyCardanoEra -> Bool
forall a. Eq a => a -> a -> Bool
== AnyCardanoEra
e2
    (QueryException, QueryException)
_ -> Bool
False

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

-- * 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
  }

-- | Construct a 'CardanoClient' handle.
mkCardanoClient :: NetworkId -> SocketPath -> CardanoClient
mkCardanoClient :: NetworkId -> SocketPath -> CardanoClient
mkCardanoClient NetworkId
networkId SocketPath
nodeSocket =
  CardanoClient
    { $sel:queryUTxOByAddress:CardanoClient :: [Address ShelleyAddr] -> IO UTxO
queryUTxOByAddress = NetworkId
-> SocketPath -> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
queryUTxO NetworkId
networkId SocketPath
nodeSocket QueryPoint
QueryTip
    , NetworkId
$sel:networkId:CardanoClient :: NetworkId
networkId :: NetworkId
networkId
    }

-- * Tx Construction / Submission

-- | Construct a simple payment consuming some inputs and producing some
-- outputs (no certificates or withdrawals involved).
--
-- On success, the returned transaction is fully balanced. On error, return
-- `TxBodyErrorAutoBalance`.
buildTransaction ::
  -- | Current network identifier
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  -- | Change address to send
  AddressInEra ->
  -- | Unspent transaction outputs to spend.
  UTxO ->
  -- | Collateral inputs.
  [TxIn] ->
  -- | Outputs to create.
  [TxOut CtxTx] ->
  IO (Either (TxBodyErrorAutoBalance Era) Tx)
buildTransaction :: NetworkId
-> SocketPath
-> AddressInEra
-> UTxO
-> [TxIn]
-> [TxOut CtxTx]
-> IO (Either (TxBodyErrorAutoBalance Era) Tx)
buildTransaction NetworkId
networkId SocketPath
socket AddressInEra
changeAddress UTxO
utxoToSpend [TxIn]
collateral [TxOut CtxTx]
outs = do
  PParams StandardConway
pparams <- NetworkId -> SocketPath -> QueryPoint -> IO (PParams LedgerEra)
queryProtocolParameters NetworkId
networkId SocketPath
socket QueryPoint
QueryTip
  SystemStart
systemStart <- NetworkId -> SocketPath -> QueryPoint -> IO SystemStart
querySystemStart NetworkId
networkId SocketPath
socket QueryPoint
QueryTip
  EraHistory
eraHistory <- NetworkId -> SocketPath -> QueryPoint -> IO EraHistory
queryEraHistory NetworkId
networkId SocketPath
socket QueryPoint
QueryTip
  Set PoolId
stakePools <- NetworkId -> SocketPath -> QueryPoint -> IO (Set PoolId)
queryStakePools NetworkId
networkId SocketPath
socket QueryPoint
QueryTip
  Either (TxBodyErrorAutoBalance Era) Tx
-> IO (Either (TxBodyErrorAutoBalance Era) Tx)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TxBodyErrorAutoBalance Era) Tx
 -> IO (Either (TxBodyErrorAutoBalance Era) Tx))
-> Either (TxBodyErrorAutoBalance Era) Tx
-> IO (Either (TxBodyErrorAutoBalance Era) Tx)
forall a b. (a -> b) -> a -> b
$
    (BalancedTxBody -> Tx)
-> Either (TxBodyErrorAutoBalance Era) BalancedTxBody
-> Either (TxBodyErrorAutoBalance Era) Tx
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((\(UnsignedTx Tx (LedgerEra Era)
unsignedTx) -> Tx LedgerEra -> Tx
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx Tx LedgerEra
Tx (LedgerEra Era)
unsignedTx) (UnsignedTx Era -> Tx)
-> (BalancedTxBody -> UnsignedTx Era) -> BalancedTxBody -> Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancedTxBody -> UnsignedTx Era
balancedTxBody) (Either (TxBodyErrorAutoBalance Era) BalancedTxBody
 -> Either (TxBodyErrorAutoBalance Era) Tx)
-> Either (TxBodyErrorAutoBalance Era) BalancedTxBody
-> Either (TxBodyErrorAutoBalance Era) Tx
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra Era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters Era
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> UTxO Era
-> TxBodyContent BuildTx Era
-> AddressInEra
-> Maybe Word
-> Either (TxBodyErrorAutoBalance Era) BalancedTxBody
forall era.
ShelleyBasedEra era
-> SystemStart
-> LedgerEpochInfo
-> LedgerProtocolParameters era
-> Set PoolId
-> Map StakeCredential Coin
-> Map (Credential 'DRepRole StandardCrypto) Coin
-> UTxO era
-> TxBodyContent BuildTx era
-> AddressInEra era
-> Maybe Word
-> Either (TxBodyErrorAutoBalance era) (BalancedTxBody era)
makeTransactionBodyAutoBalance
        ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra
        SystemStart
systemStart
        (EraHistory -> LedgerEpochInfo
toLedgerEpochInfo EraHistory
eraHistory)
        (PParams LedgerEra -> LedgerProtocolParameters Era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams StandardConway
PParams LedgerEra
pparams)
        Set PoolId
stakePools
        Map StakeCredential Coin
forall a. Monoid a => a
mempty
        Map (Credential 'DRepRole StandardCrypto) Coin
forall a. Monoid a => a
mempty
        (UTxO -> UTxO Era
UTxO.toApi UTxO
utxoToSpend)
        (PParams StandardConway -> TxBodyContent BuildTx Era
bodyContent PParams StandardConway
pparams)
        AddressInEra
changeAddress
        Maybe Word
forall a. Maybe a
Nothing
 where
  -- NOTE: 'makeTransactionBodyAutoBalance' overwrites this.
  dummyFeeForBalancing :: TxFee
dummyFeeForBalancing = Coin -> TxFee
TxFeeExplicit Coin
0

  bodyContent :: PParams StandardConway -> TxBodyContent BuildTx Era
bodyContent PParams StandardConway
pparams =
    TxIns BuildTx
-> TxInsCollateral
-> TxInsReference
-> [TxOut CtxTx]
-> TxTotalCollateral Era
-> TxReturnCollateral CtxTx Era
-> TxFee
-> TxValidityLowerBound
-> TxValidityUpperBound
-> TxMetadataInEra
-> TxAuxScripts
-> BuildTxWith BuildTx (TxSupplementalDatums Era)
-> TxExtraKeyWitnesses
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters Era))
-> TxWithdrawals BuildTx Era
-> TxCertificates BuildTx Era
-> TxUpdateProposal Era
-> TxMintValue BuildTx
-> TxScriptValidity
-> Maybe
     (Featured ConwayEraOnwards Era (TxProposalProcedures BuildTx Era))
-> Maybe
     (Featured ConwayEraOnwards Era (TxVotingProcedures BuildTx Era))
-> Maybe (Featured ConwayEraOnwards Era (Maybe Coin))
-> Maybe (Featured ConwayEraOnwards Era Coin)
-> TxBodyContent BuildTx Era
forall buidl.
TxIns buidl
-> TxInsCollateral
-> TxInsReference
-> [TxOut CtxTx]
-> TxTotalCollateral Era
-> TxReturnCollateral CtxTx Era
-> TxFee
-> TxValidityLowerBound
-> TxValidityUpperBound
-> TxMetadataInEra
-> TxAuxScripts
-> BuildTxWith buidl (TxSupplementalDatums Era)
-> TxExtraKeyWitnesses
-> BuildTxWith buidl (Maybe (LedgerProtocolParameters Era))
-> TxWithdrawals buidl Era
-> TxCertificates buidl Era
-> TxUpdateProposal Era
-> TxMintValue buidl
-> TxScriptValidity
-> Maybe
     (Featured ConwayEraOnwards Era (TxProposalProcedures buidl Era))
-> Maybe
     (Featured ConwayEraOnwards Era (TxVotingProcedures buidl Era))
-> Maybe (Featured ConwayEraOnwards Era (Maybe Coin))
-> Maybe (Featured ConwayEraOnwards Era Coin)
-> TxBodyContent buidl
TxBodyContent
      (TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn Era))
withWitness (TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn Era)))
-> [TxIn] -> TxIns BuildTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (UTxO -> Set TxIn
forall out. UTxO' out -> Set TxIn
UTxO.inputSet UTxO
utxoToSpend))
      ([TxIn] -> TxInsCollateral
TxInsCollateral [TxIn]
collateral)
      TxInsReference
TxInsReferenceNone
      [TxOut CtxTx]
outs
      TxTotalCollateral Era
forall era. TxTotalCollateral era
TxTotalCollateralNone
      TxReturnCollateral CtxTx Era
forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone
      TxFee
dummyFeeForBalancing
      TxValidityLowerBound
TxValidityNoLowerBound
      TxValidityUpperBound
TxValidityNoUpperBound
      TxMetadataInEra
TxMetadataNone
      TxAuxScripts
TxAuxScriptsNone
      (TxSupplementalDatums Era
-> BuildTxWith BuildTx (TxSupplementalDatums Era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith TxSupplementalDatums Era
forall era. TxSupplementalDatums era
TxSupplementalDataNone)
      TxExtraKeyWitnesses
TxExtraKeyWitnessesNone
      (Maybe (LedgerProtocolParameters Era)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters Era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Maybe (LedgerProtocolParameters Era)
 -> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters Era)))
-> Maybe (LedgerProtocolParameters Era)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters Era))
forall a b. (a -> b) -> a -> b
$ LedgerProtocolParameters Era
-> Maybe (LedgerProtocolParameters Era)
forall a. a -> Maybe a
Just (LedgerProtocolParameters Era
 -> Maybe (LedgerProtocolParameters Era))
-> LedgerProtocolParameters Era
-> Maybe (LedgerProtocolParameters Era)
forall a b. (a -> b) -> a -> b
$ PParams LedgerEra -> LedgerProtocolParameters Era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams StandardConway
PParams LedgerEra
pparams)
      TxWithdrawals BuildTx Era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
      TxCertificates BuildTx Era
forall build era. TxCertificates build era
TxCertificatesNone
      TxUpdateProposal Era
forall era. TxUpdateProposal era
TxUpdateProposalNone
      TxMintValue BuildTx
forall buidl. TxMintValue buidl
TxMintValueNone
      TxScriptValidity
TxScriptValidityNone
      Maybe
  (Featured ConwayEraOnwards Era (TxProposalProcedures BuildTx Era))
forall a. Maybe a
Nothing
      Maybe
  (Featured ConwayEraOnwards Era (TxVotingProcedures BuildTx Era))
forall a. Maybe a
Nothing
      Maybe (Featured ConwayEraOnwards Era (Maybe Coin))
forall a. Maybe a
Nothing
      Maybe (Featured ConwayEraOnwards Era Coin)
forall a. Maybe a
Nothing

-- | Submit a (signed) transaction to the node.
--
-- Throws 'SubmitTransactionException' if submission fails.
submitTransaction ::
  -- | Current network discriminant
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  -- | A signed transaction.
  Tx ->
  IO ()
submitTransaction :: NetworkId -> SocketPath -> Tx -> IO ()
submitTransaction NetworkId
networkId SocketPath
socket Tx
tx =
  LocalNodeConnectInfo
-> TxInMode -> IO (SubmitResult TxValidationErrorInCardanoMode)
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo
-> TxInMode -> m (SubmitResult TxValidationErrorInCardanoMode)
submitTxToNodeLocal (NetworkId -> SocketPath -> LocalNodeConnectInfo
localNodeConnectInfo NetworkId
networkId SocketPath
socket) TxInMode
txInMode IO (SubmitResult TxValidationErrorInCardanoMode)
-> (SubmitResult TxValidationErrorInCardanoMode -> 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
    SubmitResult TxValidationErrorInCardanoMode
SubmitSuccess ->
      () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    SubmitFail (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)
    SubmitFail 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)
 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 ::
  -- | Current network discriminant
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  -- | The transaction to watch / await
  Tx ->
  IO UTxO
awaitTransaction :: NetworkId -> SocketPath -> Tx -> IO UTxO
awaitTransaction NetworkId
networkId SocketPath
socket Tx
tx =
  IO UTxO
go
 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 out. UTxO' out -> Map TxIn out
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 :: IO UTxO
go = do
    UTxO
utxo <- NetworkId -> SocketPath -> QueryPoint -> [TxIn] -> IO UTxO
queryUTxOByTxIn NetworkId
networkId SocketPath
socket QueryPoint
QueryTip [TxIn]
ins
    if UTxO -> Bool
forall a. UTxO' a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null UTxO
utxo
      then IO UTxO
go
      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)

deriving anyclass instance ToJSON QueryPoint

instance Arbitrary QueryPoint where
  -- XXX: This is not complete as we lack an 'Arbitrary ChainPoint' and we have
  -- not bothered about it yet.
  arbitrary :: Gen QueryPoint
arbitrary =
    [Gen QueryPoint] -> Gen QueryPoint
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ QueryPoint -> Gen QueryPoint
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryPoint
QueryTip
      , QueryPoint -> Gen QueryPoint
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryPoint -> Gen QueryPoint) -> QueryPoint -> Gen QueryPoint
forall a b. (a -> b) -> a -> b
$ ChainPoint -> QueryPoint
QueryAt ChainPoint
ChainPointAtGenesis
      ]

-- | Query the latest chain point aka "the tip".
queryTip :: NetworkId -> SocketPath -> IO ChainPoint
queryTip :: NetworkId -> SocketPath -> IO ChainPoint
queryTip NetworkId
networkId SocketPath
socket =
  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 (NetworkId -> SocketPath -> LocalNodeConnectInfo
localNodeConnectInfo NetworkId
networkId SocketPath
socket)

-- | Query the latest chain point just for the slot number.
queryTipSlotNo :: NetworkId -> SocketPath -> IO SlotNo
queryTipSlotNo :: NetworkId -> SocketPath -> IO SlotNo
queryTipSlotNo NetworkId
networkId SocketPath
socket =
  LocalNodeConnectInfo -> IO ChainTip
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo -> m ChainTip
getLocalChainTip (NetworkId -> SocketPath -> LocalNodeConnectInfo
localNodeConnectInfo NetworkId
networkId SocketPath
socket) IO ChainTip -> (ChainTip -> IO SlotNo) -> IO SlotNo
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ChainTip
ChainTipAtGenesis -> SlotNo -> IO SlotNo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SlotNo
0
    ChainTip SlotNo
slotNo Hash BlockHeader
_ BlockNo
_ -> SlotNo -> IO SlotNo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SlotNo
slotNo

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

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

-- | Query the current epoch number.
--
-- Throws at least 'QueryException' if query fails.
queryEpochNo ::
  NetworkId ->
  SocketPath ->
  QueryPoint ->
  IO EpochNo
queryEpochNo :: NetworkId -> SocketPath -> QueryPoint -> IO EpochNo
queryEpochNo NetworkId
networkId SocketPath
socket QueryPoint
queryPoint = do
  NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO EpochNo
-> IO EpochNo
forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket QueryPoint
queryPoint (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO EpochNo
 -> IO EpochNo)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO EpochNo
-> IO EpochNo
forall a b. (a -> b) -> a -> b
$ do
    (AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr
  BlockInMode ChainPoint QueryInMode () IO AnyCardanoEra
forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr
    (ShelleyBasedEra era
sbe :: ShelleyBasedEra e) <- IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ShelleyBasedEra era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era))
-> IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
MonadThrow m =>
CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow CardanoEra era
era
    ShelleyBasedEra era
-> QueryInShelleyBasedEra era EpochNo
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO EpochNo
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr ShelleyBasedEra era
sbe QueryInShelleyBasedEra era EpochNo
forall era. QueryInShelleyBasedEra era EpochNo
QueryEpoch

-- | Query the protocol parameters at given point and convert them to Babbage
-- era protocol parameters.
--
-- Throws at least 'QueryException' if query fails.
queryProtocolParameters ::
  -- | Current network discriminant
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  QueryPoint ->
  IO (PParams LedgerEra)
queryProtocolParameters :: NetworkId -> SocketPath -> QueryPoint -> IO (PParams LedgerEra)
queryProtocolParameters NetworkId
networkId SocketPath
socket QueryPoint
queryPoint =
  NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra)
-> IO (PParams LedgerEra)
forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket 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
$ do
    (AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr
  BlockInMode ChainPoint QueryInMode () IO AnyCardanoEra
forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr
    ShelleyBasedEra era
sbe <- IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ShelleyBasedEra era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era))
-> IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
MonadThrow m =>
CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow CardanoEra era
era
    PParams (ShelleyLedgerEra era)
eraPParams <- ShelleyBasedEra era
-> QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (PParams (ShelleyLedgerEra era))
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr ShelleyBasedEra era
sbe QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
QueryProtocolParameters
    IO (PParams LedgerEra)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra)
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PParams LedgerEra)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra))
-> IO (PParams LedgerEra)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (PParams LedgerEra)
forall a b. (a -> b) -> a -> b
$ CardanoEra era
-> PParams (ShelleyLedgerEra era) -> IO (PParams LedgerEra)
forall era.
CardanoEra era
-> PParams (ShelleyLedgerEra era) -> IO (PParams LedgerEra)
coercePParamsToLedgerEra CardanoEra era
era PParams (ShelleyLedgerEra era)
eraPParams
 where
  encodeToEra :: CardanoEra era -> a -> m (PParams StandardConway)
encodeToEra CardanoEra era
eraToEncode a
pparams =
    case ByteString -> Either String (PParams StandardConway)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode' (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
pparams) of
      Left String
e -> QueryException -> m (PParams StandardConway)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> m (PParams StandardConway))
-> QueryException -> m (PParams StandardConway)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> Text -> QueryException
QueryProtocolParamsEncodingFailureOnEra (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
eraToEncode) (String -> Text
Text.pack String
e)
      Right (PParams LedgerEra
ok :: PParams LedgerEra) -> PParams StandardConway -> m (PParams StandardConway)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams StandardConway
PParams LedgerEra
ok

  coercePParamsToLedgerEra :: CardanoEra era -> PParams (ShelleyLedgerEra era) -> IO (PParams LedgerEra)
  coercePParamsToLedgerEra :: forall era.
CardanoEra era
-> PParams (ShelleyLedgerEra era) -> IO (PParams LedgerEra)
coercePParamsToLedgerEra CardanoEra era
era PParams (ShelleyLedgerEra era)
pparams =
    case CardanoEra era
era of
      CardanoEra era
ByronEra -> QueryException -> IO (PParams LedgerEra)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> IO (PParams LedgerEra))
-> QueryException -> IO (PParams LedgerEra)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> QueryException
QueryProtocolParamsEraNotSupported (CardanoEra ByronEra -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra ByronEra
ByronEra)
      CardanoEra era
ShelleyEra -> CardanoEra ShelleyEra
-> PParams StandardShelley -> IO (PParams StandardConway)
forall {a} {m :: * -> *} {era}.
(ToJSON a, MonadThrow m) =>
CardanoEra era -> a -> m (PParams StandardConway)
encodeToEra CardanoEra ShelleyEra
ShelleyEra PParams StandardShelley
PParams (ShelleyLedgerEra era)
pparams
      CardanoEra era
AllegraEra -> CardanoEra AllegraEra
-> PParams StandardAllegra -> IO (PParams StandardConway)
forall {a} {m :: * -> *} {era}.
(ToJSON a, MonadThrow m) =>
CardanoEra era -> a -> m (PParams StandardConway)
encodeToEra CardanoEra AllegraEra
AllegraEra PParams StandardAllegra
PParams (ShelleyLedgerEra era)
pparams
      CardanoEra era
MaryEra -> CardanoEra MaryEra
-> PParams StandardMary -> IO (PParams StandardConway)
forall {a} {m :: * -> *} {era}.
(ToJSON a, MonadThrow m) =>
CardanoEra era -> a -> m (PParams StandardConway)
encodeToEra CardanoEra MaryEra
MaryEra PParams StandardMary
PParams (ShelleyLedgerEra era)
pparams
      CardanoEra era
AlonzoEra -> CardanoEra AlonzoEra
-> PParams StandardAlonzo -> IO (PParams StandardConway)
forall {a} {m :: * -> *} {era}.
(ToJSON a, MonadThrow m) =>
CardanoEra era -> a -> m (PParams StandardConway)
encodeToEra CardanoEra AlonzoEra
AlonzoEra PParams StandardAlonzo
PParams (ShelleyLedgerEra era)
pparams
      CardanoEra era
BabbageEra -> CardanoEra BabbageEra
-> PParams StandardBabbage -> IO (PParams StandardConway)
forall {a} {m :: * -> *} {era}.
(ToJSON a, MonadThrow m) =>
CardanoEra era -> a -> m (PParams StandardConway)
encodeToEra CardanoEra BabbageEra
BabbageEra PParams StandardBabbage
PParams (ShelleyLedgerEra era)
pparams
      CardanoEra era
ConwayEra -> PParams StandardConway -> IO (PParams StandardConway)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams StandardConway
PParams (ShelleyLedgerEra era)
pparams

-- | Query the protocol parameters at given point. NOTE: If the era is not
-- matching this fails with an era mismatch.
--
-- Throws at least 'QueryException' if query fails.
queryProtocolParameters' ::
  IsShelleyBasedEra era =>
  -- | Current network discriminant
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  QueryPoint ->
  IO (PParams (ShelleyLedgerEra era))
queryProtocolParameters' :: forall era.
IsShelleyBasedEra era =>
NetworkId
-> SocketPath -> QueryPoint -> IO (PParams (ShelleyLedgerEra era))
queryProtocolParameters' NetworkId
networkId SocketPath
socket QueryPoint
queryPoint =
  NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (PParams (ShelleyLedgerEra era))
-> IO (PParams (ShelleyLedgerEra era))
forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket QueryPoint
queryPoint (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (PParams (ShelleyLedgerEra era))
 -> IO (PParams (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (PParams (ShelleyLedgerEra era))
-> IO (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
    ShelleyBasedEra era
-> QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (PParams (ShelleyLedgerEra era))
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
QueryProtocolParameters

-- | Query 'GenesisParameters' at a given point.
--
-- Throws at least 'QueryException' if query fails.
queryGenesisParameters ::
  -- | Current network discriminant
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  QueryPoint ->
  IO (GenesisParameters ShelleyEra)
queryGenesisParameters :: NetworkId
-> SocketPath -> QueryPoint -> IO (GenesisParameters ShelleyEra)
queryGenesisParameters NetworkId
networkId SocketPath
socket QueryPoint
queryPoint =
  NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (GenesisParameters ShelleyEra)
-> IO (GenesisParameters ShelleyEra)
forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket 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
    (AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr
  BlockInMode ChainPoint QueryInMode () IO AnyCardanoEra
forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr
    ShelleyBasedEra era
sbe <- IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ShelleyBasedEra era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era))
-> IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
MonadThrow m =>
CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow CardanoEra era
era
    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 ShelleyBasedEra era
sbe QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
forall era.
QueryInShelleyBasedEra era (GenesisParameters ShelleyEra)
QueryGenesisParameters

-- | Query UTxO for all given addresses at given point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxO :: NetworkId -> SocketPath -> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
queryUTxO :: NetworkId
-> SocketPath -> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
queryUTxO NetworkId
networkId SocketPath
socket QueryPoint
queryPoint [Address ShelleyAddr]
addresses =
  NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
-> IO UTxO
forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket 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
$ do
    (AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr
  BlockInMode ChainPoint QueryInMode () IO AnyCardanoEra
forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr
    ShelleyBasedEra era
sbe <- IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ShelleyBasedEra era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era))
-> IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
MonadThrow m =>
CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow CardanoEra era
era
    ShelleyBasedEra era
-> [Address ShelleyAddr]
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall era b p r.
ShelleyBasedEra era
-> [Address ShelleyAddr]
-> LocalStateQueryExpr b p QueryInMode r IO UTxO
queryUTxOExpr ShelleyBasedEra era
sbe [Address ShelleyAddr]
addresses

queryUTxOExpr :: ShelleyBasedEra era -> [Address ShelleyAddr] -> LocalStateQueryExpr b p QueryInMode r IO UTxO
queryUTxOExpr :: forall era b p r.
ShelleyBasedEra era
-> [Address ShelleyAddr]
-> LocalStateQueryExpr b p QueryInMode r IO UTxO
queryUTxOExpr ShelleyBasedEra era
sbe [Address ShelleyAddr]
addresses = do
  UTxO era
eraUTxO <- ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> LocalStateQueryExpr b p QueryInMode r IO (UTxO era)
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (UTxO era)
 -> LocalStateQueryExpr b p QueryInMode r IO (UTxO era))
-> QueryInShelleyBasedEra era (UTxO era)
-> LocalStateQueryExpr b p QueryInMode r IO (UTxO era)
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))
  UTxO -> LocalStateQueryExpr b p QueryInMode r IO UTxO
forall a. a -> LocalStateQueryExpr b p QueryInMode r IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO -> LocalStateQueryExpr b p QueryInMode r IO UTxO)
-> UTxO -> LocalStateQueryExpr b p QueryInMode r IO UTxO
forall a b. (a -> b) -> a -> b
$ UTxO era -> UTxO
forall era. UTxO era -> UTxO
UTxO.fromApi UTxO era
eraUTxO

-- | Query UTxO for given tx inputs at given point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxOByTxIn ::
  -- | Current network discriminant
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  QueryPoint ->
  [TxIn] ->
  IO UTxO
queryUTxOByTxIn :: NetworkId -> SocketPath -> QueryPoint -> [TxIn] -> IO UTxO
queryUTxOByTxIn NetworkId
networkId SocketPath
socket QueryPoint
queryPoint [TxIn]
inputs =
  NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
-> IO UTxO
forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket 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
$ do
    (AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr
  BlockInMode ChainPoint QueryInMode () IO AnyCardanoEra
forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr
    (ShelleyBasedEra era
sbe :: ShelleyBasedEra e) <- IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ShelleyBasedEra era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era))
-> IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
MonadThrow m =>
CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow CardanoEra era
era
    UTxO era
eraUTxO <- ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (UTxO era)
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (UTxO era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (UTxO era))
-> QueryInShelleyBasedEra era (UTxO era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (UTxO era)
forall a b. (a -> b) -> a -> b
$ 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))
    UTxO
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall a.
a -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO UTxO)
-> UTxO
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall a b. (a -> b) -> a -> b
$ UTxO era -> UTxO
forall era. UTxO era -> UTxO
UTxO.fromApi UTxO era
eraUTxO

assumeShelleyBasedEraOrThrow :: MonadThrow m => CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow :: forall (m :: * -> *) era.
MonadThrow m =>
CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow CardanoEra era
era = do
  Maybe (ShelleyBasedEra era)
x <- CardanoEra era -> m (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
  case Maybe (ShelleyBasedEra era)
x of
    Just ShelleyBasedEra era
sbe -> ShelleyBasedEra era -> m (ShelleyBasedEra era)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShelleyBasedEra era
sbe
    Maybe (ShelleyBasedEra era)
Nothing -> QueryException -> m (ShelleyBasedEra era)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (QueryException -> m (ShelleyBasedEra era))
-> QueryException -> m (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> QueryException
QueryNotShelleyBasedEraException (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era)

-- | Query the whole UTxO from node at given point. Useful for debugging, but
-- should obviously not be used in production code.
--
-- Throws at least 'QueryException' if query fails.
queryUTxOWhole ::
  -- | Current network discriminant
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  QueryPoint ->
  IO UTxO
queryUTxOWhole :: NetworkId -> SocketPath -> QueryPoint -> IO UTxO
queryUTxOWhole NetworkId
networkId SocketPath
socket QueryPoint
queryPoint = do
  NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
-> IO UTxO
forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket 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
$ do
    (AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr
  BlockInMode ChainPoint QueryInMode () IO AnyCardanoEra
forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr
    (ShelleyBasedEra era
sbe :: ShelleyBasedEra e) <- IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ShelleyBasedEra era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era))
-> IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
MonadThrow m =>
CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow CardanoEra era
era
    UTxO era
eraUTxO <- ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (UTxO era)
forall era a b p r.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era a
-> LocalStateQueryExpr b p QueryInMode r IO a
queryInShelleyBasedEraExpr ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (UTxO era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (UTxO era))
-> QueryInShelleyBasedEra era (UTxO era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (UTxO era)
forall a b. (a -> b) -> a -> b
$ QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO QueryUTxOFilter
QueryUTxOWhole
    UTxO
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall a.
a -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO UTxO)
-> UTxO
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO UTxO
forall a b. (a -> b) -> a -> b
$ UTxO era -> UTxO
forall era. UTxO era -> UTxO
UTxO.fromApi UTxO era
eraUTxO

-- | Query UTxO for the address of given verification key at point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxOFor :: NetworkId -> SocketPath -> QueryPoint -> VerificationKey PaymentKey -> IO UTxO
queryUTxOFor :: NetworkId
-> SocketPath
-> QueryPoint
-> VerificationKey PaymentKey
-> IO UTxO
queryUTxOFor NetworkId
networkId SocketPath
nodeSocket QueryPoint
queryPoint VerificationKey PaymentKey
vk =
  case NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
vk of
    ShelleyAddressInEra Address ShelleyAddr
addr ->
      NetworkId
-> SocketPath -> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
queryUTxO NetworkId
networkId SocketPath
nodeSocket QueryPoint
queryPoint [Address ShelleyAddr
addr]
    ByronAddressInEra{} ->
      String -> IO UTxO
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"impossible: mkVkAddress returned Byron address."

-- | Query the current set of registered stake pools.
--
-- Throws at least 'QueryException' if query fails.
queryStakePools ::
  -- | Current network discriminant
  NetworkId ->
  -- | Filepath to the cardano-node's domain socket
  SocketPath ->
  QueryPoint ->
  IO (Set PoolId)
queryStakePools :: NetworkId -> SocketPath -> QueryPoint -> IO (Set PoolId)
queryStakePools NetworkId
networkId SocketPath
socket QueryPoint
queryPoint =
  NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Set PoolId)
-> IO (Set PoolId)
forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket 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
    (AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr
  BlockInMode ChainPoint QueryInMode () IO AnyCardanoEra
forall b p r.
LocalStateQueryExpr b p QueryInMode r IO AnyCardanoEra
queryCurrentEraExpr
    (ShelleyBasedEra era
sbe :: ShelleyBasedEra e) <- IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ShelleyBasedEra era)
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era))
-> IO (ShelleyBasedEra era)
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
MonadThrow m =>
CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow CardanoEra era
era
    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 ShelleyBasedEra era
sbe 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 :: NetworkId -> SocketPath -> QueryPoint -> QueryInMode a -> IO a
runQuery :: forall a.
NetworkId -> SocketPath -> QueryPoint -> QueryInMode a -> IO a
runQuery NetworkId
networkId SocketPath
socket 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 (NetworkId -> SocketPath -> LocalNodeConnectInfo
localNodeConnectInfo NetworkId
networkId SocketPath
socket) 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 ::
  NetworkId ->
  SocketPath ->
  QueryPoint ->
  LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a ->
  IO a
runQueryExpr :: forall a.
NetworkId
-> SocketPath
-> QueryPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO a
runQueryExpr NetworkId
networkId SocketPath
socket 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 (NetworkId -> SocketPath -> LocalNodeConnectInfo
localNodeConnectInfo NetworkId
networkId SocketPath
socket) 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 -> Text -> m a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ UnsupportedNtcVersionError -> Text
forall b a. (Show a, IsString b) => a -> b
show UnsupportedNtcVersionError
unsupportedNtcVersion -- TODO
    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