{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.CLI.EraBased.Query.Run
  ( runQueryCmds
  , runQueryKesPeriodInfoCmd
  , runQueryLeadershipScheduleCmd
  , runQueryLedgerStateCmd
  , runQueryLedgerPeerSnapshot
  , runQueryPoolStateCmd
  , runQueryProtocolParametersCmd
  , runQueryProtocolStateCmd
  , runQuerySlotNumberCmd
  , runQueryStakeAddressInfoCmd
  , runQueryStakeDistributionCmd
  , runQueryStakePoolsCmd
  , runQueryStakeSnapshotCmd
  , runQueryTipCmd
  , runQueryTxMempoolCmd
  , runQueryUTxOCmd
  , DelegationsAndRewards (..)
  , renderQueryCmdError
  , renderOpCertIntervalInformation
  , percentage
  )
where

import Cardano.Api hiding (QueryInShelleyBasedEra (..))
import Cardano.Api qualified as Api
import Cardano.Api.Consensus qualified as Consensus
import Cardano.Api.Experimental (obtainCommonConstraints)
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Ledger (strictMaybeToMaybe)
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Network qualified as Consensus

import Cardano.Binary qualified as CBOR
import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Compatible.Json.Friendly (friendlyDRep)
import Cardano.CLI.EraBased.Genesis.Internal.Common
import Cardano.CLI.EraBased.Query.Command qualified as Cmd
import Cardano.CLI.Helper
import Cardano.CLI.Json.Encode qualified as Json
import Cardano.CLI.Read
  ( getHashFromStakePoolKeyHashSource
  )
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.QueryCmdError
import Cardano.CLI.Type.Key
  ( readDRepCredential
  , readSPOCredential
  , readVerificationKeyOrHashOrFileOrScriptHash
  )
import Cardano.CLI.Type.Output (QueryDRepStateOutput (..))
import Cardano.CLI.Type.Output qualified as O
import Cardano.Crypto.Hash (hashToBytesAsHex)
import Cardano.Ledger.Api.State.Query qualified as L
import Cardano.Ledger.Conway.State (ChainAccountState (..))
import Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCTime, hoistEpochInfo)
import Cardano.Slotting.Time (RelativeTime (..), toRelativeTime)
import Ouroboros.Consensus.Cardano.Block (CardanoBlock, StandardCrypto)
import Ouroboros.Consensus.HardFork.Combinator.NetworkVersion
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion

import RIO hiding (toList)

import Control.Monad.Morph
import Data.Aeson as Aeson
import Data.ByteString.Base16.Lazy qualified as Base16
import Data.ByteString.Lazy qualified as BS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Coerce (coerce)
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.SOP.Index
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Text.IO qualified as T
import Data.Text.Lazy.IO qualified as LT
import Data.Time.Clock
import GHC.Exts (IsList (..))
import Numeric (showEFloat)
import Prettyprinter
import Prettyprinter.Render.Terminal (AnsiStyle)
import System.IO qualified as IO
import Text.Printf (printf)
import Vary

runQueryCmds :: Cmd.QueryCmds era -> CIO e ()
runQueryCmds :: forall era e. QueryCmds era -> CIO e ()
runQueryCmds = \case
  Cmd.QueryCommitteeMembersStateCmd QueryCommitteeMembersStateCmdArgs era
args -> QueryCommitteeMembersStateCmdArgs era -> CIO e ()
forall era e. QueryCommitteeMembersStateCmdArgs era -> CIO e ()
runQueryCommitteeMembersState QueryCommitteeMembersStateCmdArgs era
args
  Cmd.QueryConstitutionCmd QueryNoArgCmdArgs era
args -> QueryNoArgCmdArgs era -> CIO e ()
forall era e. QueryNoArgCmdArgs era -> CIO e ()
runQueryConstitution QueryNoArgCmdArgs era
args
  Cmd.QueryDRepStakeDistributionCmd QueryDRepStakeDistributionCmdArgs era
args -> QueryDRepStakeDistributionCmdArgs era -> CIO e ()
forall era e. QueryDRepStakeDistributionCmdArgs era -> CIO e ()
runQueryDRepStakeDistribution QueryDRepStakeDistributionCmdArgs era
args
  Cmd.QueryDRepStateCmd QueryDRepStateCmdArgs era
args -> QueryDRepStateCmdArgs era -> CIO e ()
forall era e. QueryDRepStateCmdArgs era -> CIO e ()
runQueryDRepState QueryDRepStateCmdArgs era
args
  Cmd.QueryEraHistoryCmd QueryEraHistoryCmdArgs
args -> QueryEraHistoryCmdArgs -> CIO e ()
forall e. QueryEraHistoryCmdArgs -> CIO e ()
runQueryEraHistoryCmd QueryEraHistoryCmdArgs
args
  Cmd.QueryFuturePParamsCmd QueryNoArgCmdArgs era
args -> QueryNoArgCmdArgs era -> CIO e ()
forall era e. QueryNoArgCmdArgs era -> CIO e ()
runQueryFuturePParams QueryNoArgCmdArgs era
args
  Cmd.QueryGovStateCmd QueryNoArgCmdArgs era
args -> QueryNoArgCmdArgs era -> CIO e ()
forall era e. QueryNoArgCmdArgs era -> CIO e ()
runQueryGovState QueryNoArgCmdArgs era
args
  Cmd.QueryKesPeriodInfoCmd QueryKesPeriodInfoCmdArgs
args -> QueryKesPeriodInfoCmdArgs -> CIO e ()
forall e. QueryKesPeriodInfoCmdArgs -> CIO e ()
runQueryKesPeriodInfoCmd QueryKesPeriodInfoCmdArgs
args
  Cmd.QueryLeadershipScheduleCmd QueryLeadershipScheduleCmdArgs
args -> QueryLeadershipScheduleCmdArgs -> CIO e ()
forall e. QueryLeadershipScheduleCmdArgs -> CIO e ()
runQueryLeadershipScheduleCmd QueryLeadershipScheduleCmdArgs
args
  Cmd.QueryLedgerPeerSnapshotCmd QueryLedgerPeerSnapshotCmdArgs
args -> QueryLedgerPeerSnapshotCmdArgs -> CIO e ()
forall e. QueryLedgerPeerSnapshotCmdArgs -> CIO e ()
runQueryLedgerPeerSnapshot QueryLedgerPeerSnapshotCmdArgs
args
  Cmd.QueryLedgerStateCmd QueryLedgerStateCmdArgs
args -> QueryLedgerStateCmdArgs -> CIO e ()
forall e. QueryLedgerStateCmdArgs -> CIO e ()
runQueryLedgerStateCmd QueryLedgerStateCmdArgs
args
  Cmd.QueryPoolStateCmd QueryPoolStateCmdArgs
args -> QueryPoolStateCmdArgs -> CIO e ()
forall e. QueryPoolStateCmdArgs -> CIO e ()
runQueryPoolStateCmd QueryPoolStateCmdArgs
args
  Cmd.QueryProposalsCmd QueryProposalsCmdArgs era
args -> QueryProposalsCmdArgs era -> CIO e ()
forall era e. QueryProposalsCmdArgs era -> CIO e ()
runQueryProposals QueryProposalsCmdArgs era
args
  Cmd.QueryProtocolParametersCmd QueryProtocolParametersCmdArgs
args -> QueryProtocolParametersCmdArgs -> CIO e ()
forall e. QueryProtocolParametersCmdArgs -> CIO e ()
runQueryProtocolParametersCmd QueryProtocolParametersCmdArgs
args
  Cmd.QueryProtocolStateCmd QueryProtocolStateCmdArgs
args -> QueryProtocolStateCmdArgs -> CIO e ()
forall e. QueryProtocolStateCmdArgs -> CIO e ()
runQueryProtocolStateCmd QueryProtocolStateCmdArgs
args
  Cmd.QueryRatifyStateCmd QueryNoArgCmdArgs era
args -> QueryNoArgCmdArgs era -> CIO e ()
forall era e. QueryNoArgCmdArgs era -> CIO e ()
runQueryRatifyState QueryNoArgCmdArgs era
args
  Cmd.QueryRefScriptSizeCmd QueryRefScriptSizeCmdArgs
args -> QueryRefScriptSizeCmdArgs -> CIO e ()
forall e. QueryRefScriptSizeCmdArgs -> CIO e ()
runQueryRefScriptSizeCmd QueryRefScriptSizeCmdArgs
args
  Cmd.QuerySlotNumberCmd QuerySlotNumberCmdArgs
args -> QuerySlotNumberCmdArgs -> CIO e ()
forall e. QuerySlotNumberCmdArgs -> CIO e ()
runQuerySlotNumberCmd QuerySlotNumberCmdArgs
args
  Cmd.QuerySPOStakeDistributionCmd QuerySPOStakeDistributionCmdArgs era
args -> QuerySPOStakeDistributionCmdArgs era -> CIO e ()
forall era e. QuerySPOStakeDistributionCmdArgs era -> CIO e ()
runQuerySPOStakeDistribution QuerySPOStakeDistributionCmdArgs era
args
  Cmd.QueryStakeAddressInfoCmd QueryStakeAddressInfoCmdArgs
args -> QueryStakeAddressInfoCmdArgs -> CIO e ()
forall e. QueryStakeAddressInfoCmdArgs -> CIO e ()
runQueryStakeAddressInfoCmd QueryStakeAddressInfoCmdArgs
args
  Cmd.QueryStakeDistributionCmd QueryStakeDistributionCmdArgs
args -> QueryStakeDistributionCmdArgs -> CIO e ()
forall e. QueryStakeDistributionCmdArgs -> CIO e ()
runQueryStakeDistributionCmd QueryStakeDistributionCmdArgs
args
  Cmd.QueryStakePoolDefaultVoteCmd QueryStakePoolDefaultVoteCmdArgs era
args -> QueryStakePoolDefaultVoteCmdArgs era -> CIO e ()
forall era e. QueryStakePoolDefaultVoteCmdArgs era -> CIO e ()
runQueryStakePoolDefaultVote QueryStakePoolDefaultVoteCmdArgs era
args
  Cmd.QueryStakePoolsCmd QueryStakePoolsCmdArgs
args -> QueryStakePoolsCmdArgs -> CIO e ()
forall e. QueryStakePoolsCmdArgs -> CIO e ()
runQueryStakePoolsCmd QueryStakePoolsCmdArgs
args
  Cmd.QueryStakeSnapshotCmd QueryStakeSnapshotCmdArgs
args -> QueryStakeSnapshotCmdArgs -> CIO e ()
forall e. QueryStakeSnapshotCmdArgs -> CIO e ()
runQueryStakeSnapshotCmd QueryStakeSnapshotCmdArgs
args
  Cmd.QueryTipCmd QueryTipCmdArgs
args -> QueryTipCmdArgs -> CIO e ()
forall e. QueryTipCmdArgs -> CIO e ()
runQueryTipCmd QueryTipCmdArgs
args
  Cmd.QueryTreasuryValueCmd QueryTreasuryValueCmdArgs era
args -> QueryTreasuryValueCmdArgs era -> CIO e ()
forall era e. QueryTreasuryValueCmdArgs era -> CIO e ()
runQueryTreasuryValue QueryTreasuryValueCmdArgs era
args
  Cmd.QueryTxMempoolCmd QueryTxMempoolCmdArgs
args -> QueryTxMempoolCmdArgs -> CIO e ()
forall e. QueryTxMempoolCmdArgs -> CIO e ()
runQueryTxMempoolCmd QueryTxMempoolCmdArgs
args
  Cmd.QueryUTxOCmd QueryUTxOCmdArgs
args -> QueryUTxOCmdArgs -> CIO e ()
forall e. QueryUTxOCmdArgs -> CIO e ()
runQueryUTxOCmd QueryUTxOCmdArgs
args

runQueryProtocolParametersCmd
  :: ()
  => Cmd.QueryProtocolParametersCmdArgs
  -> CIO e ()
runQueryProtocolParametersCmd :: forall e. QueryProtocolParametersCmdArgs -> CIO e ()
runQueryProtocolParametersCmd
  Cmd.QueryProtocolParametersCmdArgs
    { LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
nodeConnInfo :: QueryProtocolParametersCmdArgs -> LocalNodeConnectInfo
Cmd.nodeConnInfo
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: QueryProtocolParametersCmdArgs -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryProtocolParametersCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    anyCEra :: AnyCardanoEra
anyCEra@(AnyCardanoEra CardanoEra era
cEra) <- ExceptT AcquiringFailure IO AnyCardanoEra -> RIO e AnyCardanoEra
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT AcquiringFailure IO AnyCardanoEra -> RIO e AnyCardanoEra)
-> ExceptT AcquiringFailure IO AnyCardanoEra -> RIO e AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo -> ExceptT AcquiringFailure IO AnyCardanoEra
determineEra LocalNodeConnectInfo
nodeConnInfo
    case CardanoEra era
-> (ShelleyBasedEra era -> ShelleyBasedEra era)
-> Maybe (ShelleyBasedEra era)
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> (eon era -> a) -> Maybe a
forEraInEonMaybe CardanoEra era
cEra ShelleyBasedEra era -> ShelleyBasedEra era
forall a. a -> a
id of
      Maybe (ShelleyBasedEra era)
Nothing -> QueryCmdError -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (QueryCmdError -> RIO e ()) -> QueryCmdError -> RIO e ()
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> QueryCmdError
QueryCmdEraNotSupported AnyCardanoEra
anyCEra
      Just ShelleyBasedEra era
sbe -> do
        let qInMode :: QueryInMode (Either EraMismatch (PParams (ShelleyLedgerEra era)))
qInMode = QueryInEra era (PParams (ShelleyLedgerEra era))
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall era result1.
QueryInEra era result1 -> QueryInMode (Either EraMismatch result1)
QueryInEra (QueryInEra era (PParams (ShelleyLedgerEra era))
 -> QueryInMode
      (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> QueryInEra era (PParams (ShelleyLedgerEra era))
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
-> QueryInEra era (PParams (ShelleyLedgerEra era))
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
Api.QueryProtocolParameters

        PParams (ShelleyLedgerEra era)
pparams <-
          ExceptT QueryConvenienceError IO (PParams (ShelleyLedgerEra era))
-> RIO e (PParams (ShelleyLedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryConvenienceError IO (PParams (ShelleyLedgerEra era))
 -> RIO e (PParams (ShelleyLedgerEra era)))
-> ExceptT
     QueryConvenienceError IO (PParams (ShelleyLedgerEra era))
-> RIO e (PParams (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
            LocalNodeConnectInfo
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
-> ExceptT
     QueryConvenienceError IO (PParams (ShelleyLedgerEra era))
forall result.
LocalNodeConnectInfo
-> QueryInMode (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO result
executeQueryAnyMode LocalNodeConnectInfo
nodeConnInfo QueryInMode (Either EraMismatch (PParams (ShelleyLedgerEra era)))
qInMode

        let output :: ByteString
output =
              ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe
                ((ShelleyBasedEraConstraints era => ByteString) -> ByteString)
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[FormatJson, FormatYaml]
outputFormat
                  Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> PParams (ShelleyLedgerEra era) -> ByteString)
-> PParams (ShelleyLedgerEra era)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> PParams (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> PParams (ShelleyLedgerEra era)
-> ByteString
forall a. a -> a
id
                        ((Vary '[FormatJson, FormatYaml]
  -> PParams (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> PParams (ShelleyLedgerEra era)
 -> ByteString)
-> ((Vary '[] -> PParams (ShelleyLedgerEra era) -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> PParams (ShelleyLedgerEra era)
    -> ByteString)
-> (Vary '[] -> PParams (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> PParams (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> PParams (ShelleyLedgerEra era) -> ByteString)
-> (Vary '[FormatYaml]
    -> PParams (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> PParams (ShelleyLedgerEra era)
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> PParams (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                        ((Vary '[FormatYaml]
  -> PParams (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> PParams (ShelleyLedgerEra era)
 -> ByteString)
-> ((Vary '[] -> PParams (ShelleyLedgerEra era) -> ByteString)
    -> Vary '[FormatYaml]
    -> PParams (ShelleyLedgerEra era)
    -> ByteString)
-> (Vary '[] -> PParams (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> PParams (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> PParams (ShelleyLedgerEra era) -> ByteString)
-> (Vary '[] -> PParams (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatYaml]
-> PParams (ShelleyLedgerEra era)
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> PParams (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                        ((Vary '[] -> PParams (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> PParams (ShelleyLedgerEra era)
 -> ByteString)
-> (Vary '[] -> PParams (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> PParams (ShelleyLedgerEra era)
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> PParams (ShelleyLedgerEra era) -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
                    )
                (PParams (ShelleyLedgerEra era) -> ByteString)
-> PParams (ShelleyLedgerEra era) -> ByteString
forall a b. (a -> b) -> a -> b
$ PParams (ShelleyLedgerEra era)
pparams

        forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
          Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

-- | Calculate the percentage sync rendered as text: @min 1 (tipTime/nowTime)@
percentage
  :: RelativeTime
  -- ^ @tolerance@.  If @b - a < tolerance@, then 100% is reported.  This even if we are @tolerance@ seconds
  -- behind, we are still considered fully synced.
  -> RelativeTime
  -- ^ @tipTime@ The time of the most recently synced block.
  -> RelativeTime
  -- ^ @nowTime@ The time of the tip of the block chain to which we need to sync.
  -> Text
percentage :: RelativeTime -> RelativeTime -> RelativeTime -> Text
percentage RelativeTime
tolerance RelativeTime
a RelativeTime
b = FilePath -> Text
Text.pack (FilePath -> Double -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%.2f" Double
pc)
 where
  -- All calculations are in seconds (Integer)
  t :: Integer
t = RelativeTime -> Integer
relativeTimeSeconds RelativeTime
tolerance
  -- Plus 1 to prevent division by zero.  The 's' prefix stands for strictly-positive.
  sa :: Integer
sa = RelativeTime -> Integer
relativeTimeSeconds RelativeTime
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
  sb :: Integer
sb = RelativeTime -> Integer
relativeTimeSeconds RelativeTime
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
  -- Fast forward the 'nowTime` by the tolerance, but don't let the result exceed the tip time.
  ua :: Integer
ua = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Integer
sa Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
t) Integer
sb
  ub :: Integer
ub = Integer
sb
  -- Final percentage to render as text.
  pc :: Double
pc = (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ua Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ub) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100.0 :: Double

  relativeTimeSeconds :: RelativeTime -> Integer
  relativeTimeSeconds :: RelativeTime -> Integer
relativeTimeSeconds (RelativeTime NominalDiffTime
dt) = Pico -> Integer
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
dt)

-- | Query the chain tip via the chain sync protocol.
--
-- This is a fallback query to support older versions of node to client protocol.
queryChainTipViaChainSync :: MonadIO m => LocalNodeConnectInfo -> m ChainTip
queryChainTipViaChainSync :: forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo -> m ChainTip
queryChainTipViaChainSync LocalNodeConnectInfo
localNodeConnInfo = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
T.hPutStrLn Handle
IO.stderr (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
    Text
"Warning: Local header state query unavailable. Falling back to chain sync query"
  IO ChainTip -> m ChainTip
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainTip -> m ChainTip) -> IO ChainTip -> m ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo -> IO ChainTip
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo -> m ChainTip
getLocalChainTip LocalNodeConnectInfo
localNodeConnInfo

runQueryTipCmd
  :: ()
  => Cmd.QueryTipCmdArgs
  -> CIO e ()
runQueryTipCmd :: forall e. QueryTipCmdArgs -> CIO e ()
runQueryTipCmd
  ( Cmd.QueryTipCmdArgs
      { commons :: QueryTipCmdArgs -> QueryCommons
Cmd.commons =
        Cmd.QueryCommons
          { LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
Cmd.nodeConnInfo
          , Target ChainPoint
target :: Target ChainPoint
target :: QueryCommons -> Target ChainPoint
Cmd.target
          }
      , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: QueryTipCmdArgs -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryTipCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
      }
    ) = do
    Either AcquiringFailure (QueryTipLocalState Any)
eLocalState <- IO
  (Either
     QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
-> RIO e (Either AcquiringFailure (QueryTipLocalState Any))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either
      QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
 -> RIO e (Either AcquiringFailure (QueryTipLocalState Any)))
-> IO
     (Either
        QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
-> RIO e (Either AcquiringFailure (QueryTipLocalState Any))
forall a b. (a -> b) -> a -> b
$
      (Either
   AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any))
 -> Either
      QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
-> IO
     (Either
        QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either
  AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any))
-> Either
     QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Either AcquiringFailure (m a) -> m (Either AcquiringFailure a)
sequence (IO
   (Either
      AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
 -> IO
      (Either
         QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any))))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
-> IO
     (Either
        QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState Any))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (QueryTipLocalState Any))
 -> IO
      (Either
         AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState Any))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
forall a b. (a -> b) -> a -> b
$
          ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (QueryTipLocalState Any)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState Any))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (QueryTipLocalState Any)
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (QueryTipLocalState Any)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (QueryTipLocalState Any)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState Any))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra
era <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError AnyCardanoEra)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError AnyCardanoEra)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      AnyCardanoEra)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)
            EraHistory
eraHistory <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError EraHistory)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError EraHistory)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError EraHistory)
queryEraHistory ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError EraHistory)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError EraHistory)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      EraHistory)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)
            Maybe (WithOrigin BlockNo)
mChainBlockNo <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
queryChainBlockNo ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (WithOrigin BlockNo))
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion) ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (WithOrigin BlockNo)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (WithOrigin BlockNo)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (Maybe (WithOrigin BlockNo)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (WithOrigin BlockNo))
forall a b. a -> (a -> b) -> b
& (WithOrigin BlockNo -> Maybe (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (WithOrigin BlockNo))
forall a b.
(a -> b)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithOrigin BlockNo -> Maybe (WithOrigin BlockNo)
forall a. a -> Maybe a
Just
            Maybe ChainPoint
mChainPoint <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError ChainPoint)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError ChainPoint)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError ChainPoint)
queryChainPoint ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError ChainPoint)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError ChainPoint)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ChainPoint)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion) ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ChainPoint
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ChainPoint
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (Maybe ChainPoint))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe ChainPoint)
forall a b. a -> (a -> b) -> b
& (ChainPoint -> Maybe ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe ChainPoint)
forall a b.
(a -> b)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChainPoint -> Maybe ChainPoint
forall a. a -> Maybe a
Just
            Maybe SystemStart
mSystemStart <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError SystemStart)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError SystemStart)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError SystemStart)
querySystemStart ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError SystemStart)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError SystemStart)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      SystemStart)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion) ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  SystemStart
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      SystemStart
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (Maybe SystemStart))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe SystemStart)
forall a b. a -> (a -> b) -> b
& (SystemStart -> Maybe SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe SystemStart)
forall a b.
(a -> b)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SystemStart -> Maybe SystemStart
forall a. a -> Maybe a
Just

            QueryTipLocalState Any
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (QueryTipLocalState Any)
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (m :: * -> *) a. Monad m => a -> m a
return
              O.QueryTipLocalState
                { era :: AnyCardanoEra
O.era = AnyCardanoEra
era
                , eraHistory :: EraHistory
O.eraHistory = EraHistory
eraHistory
                , mSystemStart :: Maybe SystemStart
O.mSystemStart = Maybe SystemStart
mSystemStart
                , mChainTip :: Maybe ChainTip
O.mChainTip = WithOrigin BlockNo -> ChainPoint -> ChainTip
makeChainTip (WithOrigin BlockNo -> ChainPoint -> ChainTip)
-> Maybe (WithOrigin BlockNo) -> Maybe (ChainPoint -> ChainTip)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (WithOrigin BlockNo)
mChainBlockNo Maybe (ChainPoint -> ChainTip)
-> Maybe ChainPoint -> Maybe ChainTip
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChainPoint
mChainPoint
                }

    Maybe (QueryTipLocalState Any)
mLocalState <- Either QueryCmdError (QueryTipLocalState Any)
-> (QueryCmdError -> RIO e ())
-> RIO e (Maybe (QueryTipLocalState Any))
forall (m :: * -> *) e a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM ((AcquiringFailure -> QueryCmdError)
-> Either AcquiringFailure (QueryTipLocalState Any)
-> Either QueryCmdError (QueryTipLocalState Any)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure Either AcquiringFailure (QueryTipLocalState Any)
eLocalState) ((QueryCmdError -> RIO e ())
 -> RIO e (Maybe (QueryTipLocalState Any)))
-> (QueryCmdError -> RIO e ())
-> RIO e (Maybe (QueryTipLocalState Any))
forall a b. (a -> b) -> a -> b
$ \QueryCmdError
e ->
      IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> (Text -> IO ()) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
LT.hPutStrLn Handle
IO.stderr (Text -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$
        Doc AnsiStyle -> Text
docToLazyText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$
          Doc AnsiStyle
"Warning: Local state unavailable: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> QueryCmdError -> Doc AnsiStyle
forall ann. QueryCmdError -> Doc ann
renderQueryCmdError QueryCmdError
e

    ChainTip
chainTip <-
      case Maybe (QueryTipLocalState Any)
mLocalState Maybe (QueryTipLocalState Any)
-> (QueryTipLocalState Any -> Maybe ChainTip) -> Maybe ChainTip
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalState Any -> Maybe ChainTip
forall mode. QueryTipLocalState mode -> Maybe ChainTip
O.mChainTip of
        Maybe ChainTip
Nothing -> LocalNodeConnectInfo -> RIO e ChainTip
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo -> m ChainTip
queryChainTipViaChainSync LocalNodeConnectInfo
nodeConnInfo
        Just ChainTip
tip -> ChainTip -> RIO e ChainTip
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainTip
tip
    -- The chain tip is unavailable via local state query because we are connecting with an older
    -- node to client protocol so we use chain sync instead which necessitates another connection.
    -- At some point when we can stop supporting the older node to client protocols, this fallback
    -- can be removed.

    let SlotNo
tipSlotNo :: SlotNo = case ChainTip
chainTip of
          ChainTip
ChainTipAtGenesis -> SlotNo
0
          ChainTip SlotNo
slotNo Hash BlockHeader
_ BlockNo
_ -> SlotNo
slotNo

    Maybe QueryTipLocalStateOutput
localStateOutput <- Maybe (QueryTipLocalState Any)
-> (QueryTipLocalState Any -> RIO e QueryTipLocalStateOutput)
-> RIO e (Maybe QueryTipLocalStateOutput)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (QueryTipLocalState Any)
mLocalState ((QueryTipLocalState Any -> RIO e QueryTipLocalStateOutput)
 -> RIO e (Maybe QueryTipLocalStateOutput))
-> (QueryTipLocalState Any -> RIO e QueryTipLocalStateOutput)
-> RIO e (Maybe QueryTipLocalStateOutput)
forall a b. (a -> b) -> a -> b
$ \QueryTipLocalState Any
localState -> do
      case SlotNo
-> EraHistory
-> Either
     PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
slotToEpoch SlotNo
tipSlotNo (QueryTipLocalState Any -> EraHistory
forall mode. QueryTipLocalState mode -> EraHistory
O.eraHistory QueryTipLocalState Any
localState) of
        Left PastHorizonException
e -> do
          IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> (Text -> IO ()) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
LT.hPutStrLn Handle
IO.stderr (Text -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle -> Text
docToLazyText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$
              Doc AnsiStyle
"Warning: Epoch unavailable: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> QueryCmdError -> Doc AnsiStyle
forall ann. QueryCmdError -> Doc ann
renderQueryCmdError (PastHorizonException -> QueryCmdError
QueryCmdPastHorizon PastHorizonException
e)
          QueryTipLocalStateOutput -> RIO e QueryTipLocalStateOutput
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryTipLocalStateOutput -> RIO e QueryTipLocalStateOutput)
-> QueryTipLocalStateOutput -> RIO e QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$
            O.QueryTipLocalStateOutput
              { localStateChainTip :: ChainTip
O.localStateChainTip = ChainTip
chainTip
              , mEra :: Maybe AnyCardanoEra
O.mEra = Maybe AnyCardanoEra
forall a. Maybe a
Nothing
              , mEpoch :: Maybe EpochNo
O.mEpoch = Maybe EpochNo
forall a. Maybe a
Nothing
              , mSyncProgress :: Maybe Text
O.mSyncProgress = Maybe Text
forall a. Maybe a
Nothing
              , mSlotInEpoch :: Maybe Word64
O.mSlotInEpoch = Maybe Word64
forall a. Maybe a
Nothing
              , mSlotsToEpochEnd :: Maybe Word64
O.mSlotsToEpochEnd = Maybe Word64
forall a. Maybe a
Nothing
              }
        Right (EpochNo
epochNo, SlotsInEpoch Word64
slotsInEpoch, SlotsToEpochEnd Word64
slotsToEpochEnd) -> do
          Either QueryCmdError Text
syncProgressResult <- ExceptT QueryCmdError (RIO e) Text
-> RIO e (Either QueryCmdError Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QueryCmdError (RIO e) Text
 -> RIO e (Either QueryCmdError Text))
-> ExceptT QueryCmdError (RIO e) Text
-> RIO e (Either QueryCmdError Text)
forall a b. (a -> b) -> a -> b
$ do
            UTCTime
systemStart <-
              (SystemStart -> UTCTime) -> Maybe SystemStart -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SystemStart -> UTCTime
getSystemStart (QueryTipLocalState Any -> Maybe SystemStart
forall mode. QueryTipLocalState mode -> Maybe SystemStart
O.mSystemStart QueryTipLocalState Any
localState) Maybe UTCTime
-> (Maybe UTCTime -> ExceptT QueryCmdError (RIO e) UTCTime)
-> ExceptT QueryCmdError (RIO e) UTCTime
forall a b. a -> (a -> b) -> b
& QueryCmdError
-> Maybe UTCTime -> ExceptT QueryCmdError (RIO e) UTCTime
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe QueryCmdError
QueryCmdSystemStartUnavailable
            RelativeTime
nowSeconds <- SystemStart -> UTCTime -> RelativeTime
toRelativeTime (UTCTime -> SystemStart
SystemStart UTCTime
systemStart) (UTCTime -> RelativeTime)
-> ExceptT QueryCmdError (RIO e) UTCTime
-> ExceptT QueryCmdError (RIO e) RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> ExceptT QueryCmdError (RIO e) UTCTime
forall a. IO a -> ExceptT QueryCmdError (RIO e) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            RelativeTime
tipTimeResult <-
              SlotNo
-> EraHistory
-> Either PastHorizonException (RelativeTime, SlotLength)
getProgress SlotNo
tipSlotNo (QueryTipLocalState Any -> EraHistory
forall mode. QueryTipLocalState mode -> EraHistory
O.eraHistory QueryTipLocalState Any
localState) Either PastHorizonException (RelativeTime, SlotLength)
-> (Either PastHorizonException (RelativeTime, SlotLength)
    -> Either QueryCmdError RelativeTime)
-> Either QueryCmdError RelativeTime
forall a b. a -> (a -> b) -> b
& (PastHorizonException -> QueryCmdError)
-> ((RelativeTime, SlotLength) -> RelativeTime)
-> Either PastHorizonException (RelativeTime, SlotLength)
-> Either QueryCmdError RelativeTime
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap PastHorizonException -> QueryCmdError
QueryCmdPastHorizon (RelativeTime, SlotLength) -> RelativeTime
forall a b. (a, b) -> a
fst Either QueryCmdError RelativeTime
-> (Either QueryCmdError RelativeTime
    -> ExceptT QueryCmdError (RIO e) RelativeTime)
-> ExceptT QueryCmdError (RIO e) RelativeTime
forall a b. a -> (a -> b) -> b
& Either QueryCmdError RelativeTime
-> ExceptT QueryCmdError (RIO e) RelativeTime
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except

            let tolerance :: RelativeTime
tolerance = NominalDiffTime -> RelativeTime
RelativeTime (Pico -> NominalDiffTime
secondsToNominalDiffTime Pico
600)

            Text -> ExceptT QueryCmdError (RIO e) Text
forall a. a -> ExceptT QueryCmdError (RIO e) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExceptT QueryCmdError (RIO e) Text)
-> Text -> ExceptT QueryCmdError (RIO e) Text
forall a b. (a -> b) -> a -> b
$ RelativeTime -> RelativeTime -> RelativeTime -> Text
percentage RelativeTime
tolerance RelativeTime
tipTimeResult RelativeTime
nowSeconds

          Maybe Text
mSyncProgress <- Either QueryCmdError Text
-> (QueryCmdError -> RIO e ()) -> RIO e (Maybe Text)
forall (m :: * -> *) e a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM Either QueryCmdError Text
syncProgressResult ((QueryCmdError -> RIO e ()) -> RIO e (Maybe Text))
-> (QueryCmdError -> RIO e ()) -> RIO e (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \QueryCmdError
e -> do
            IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> (Text -> IO ()) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
LT.hPutStrLn Handle
IO.stderr (Text -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$
              Doc AnsiStyle -> Text
docToLazyText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$
                Doc AnsiStyle
"Warning: Sync progress unavailable: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> QueryCmdError -> Doc AnsiStyle
forall ann. QueryCmdError -> Doc ann
renderQueryCmdError QueryCmdError
e

          QueryTipLocalStateOutput -> RIO e QueryTipLocalStateOutput
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryTipLocalStateOutput -> RIO e QueryTipLocalStateOutput)
-> QueryTipLocalStateOutput -> RIO e QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$
            O.QueryTipLocalStateOutput
              { localStateChainTip :: ChainTip
O.localStateChainTip = ChainTip
chainTip
              , mEra :: Maybe AnyCardanoEra
O.mEra = AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (QueryTipLocalState Any -> AnyCardanoEra
forall mode. QueryTipLocalState mode -> AnyCardanoEra
O.era QueryTipLocalState Any
localState)
              , mEpoch :: Maybe EpochNo
O.mEpoch = EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
epochNo
              , mSlotInEpoch :: Maybe Word64
O.mSlotInEpoch = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
slotsInEpoch
              , mSlotsToEpochEnd :: Maybe Word64
O.mSlotsToEpochEnd = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
slotsToEpochEnd
              , mSyncProgress :: Maybe Text
O.mSyncProgress = Maybe Text
mSyncProgress
              }

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> Maybe QueryTipLocalStateOutput -> ByteString)
-> Maybe QueryTipLocalStateOutput
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> Maybe QueryTipLocalStateOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe QueryTipLocalStateOutput
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> Maybe QueryTipLocalStateOutput -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Maybe QueryTipLocalStateOutput
 -> ByteString)
-> ((Vary '[] -> Maybe QueryTipLocalStateOutput -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> Maybe QueryTipLocalStateOutput
    -> ByteString)
-> (Vary '[] -> Maybe QueryTipLocalStateOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe QueryTipLocalStateOutput
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> Maybe QueryTipLocalStateOutput -> ByteString)
-> (Vary '[FormatYaml]
    -> Maybe QueryTipLocalStateOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe QueryTipLocalStateOutput
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> Maybe QueryTipLocalStateOutput -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml]
  -> Maybe QueryTipLocalStateOutput -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Maybe QueryTipLocalStateOutput
 -> ByteString)
-> ((Vary '[] -> Maybe QueryTipLocalStateOutput -> ByteString)
    -> Vary '[FormatYaml]
    -> Maybe QueryTipLocalStateOutput
    -> ByteString)
-> (Vary '[] -> Maybe QueryTipLocalStateOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe QueryTipLocalStateOutput
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> Maybe QueryTipLocalStateOutput -> ByteString)
-> (Vary '[] -> Maybe QueryTipLocalStateOutput -> ByteString)
-> Vary '[FormatYaml]
-> Maybe QueryTipLocalStateOutput
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> Maybe QueryTipLocalStateOutput -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> Maybe QueryTipLocalStateOutput -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Maybe QueryTipLocalStateOutput
 -> ByteString)
-> (Vary '[] -> Maybe QueryTipLocalStateOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe QueryTipLocalStateOutput
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> Maybe QueryTipLocalStateOutput -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (Maybe QueryTipLocalStateOutput -> ByteString)
-> Maybe QueryTipLocalStateOutput -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe QueryTipLocalStateOutput
localStateOutput

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

-- | Query the UTxO, filtered by a given set of addresses, from a Shelley node
-- via the local state query protocol.
runQueryUTxOCmd
  :: ()
  => Cmd.QueryUTxOCmdArgs
  -> CIO e ()
runQueryUTxOCmd :: forall e. QueryUTxOCmdArgs -> CIO e ()
runQueryUTxOCmd
  ( Cmd.QueryUTxOCmdArgs
      { commons :: QueryUTxOCmdArgs -> QueryCommons
Cmd.commons =
        Cmd.QueryCommons
          { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
          , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
          }
      , QueryUTxOFilter
queryFilter :: QueryUTxOFilter
queryFilter :: QueryUTxOCmdArgs -> QueryUTxOFilter
Cmd.queryFilter
      , Vary
  '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
outputFormat :: Vary
  '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
outputFormat :: QueryUTxOCmdArgs
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
Cmd.outputFormat
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryUTxOCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
      }
    ) = do
    IO (Either AcquiringFailure (Either QueryCmdError ()))
-> RIO e (Either QueryCmdError ())
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
      ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
 -> IO (Either AcquiringFailure (Either QueryCmdError ())))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ()
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ()))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$ do
          anyCEra :: AnyCardanoEra
anyCEra@(AnyCardanoEra CardanoEra era
cEra) <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          case CardanoEra era
-> (ShelleyBasedEra era -> ShelleyBasedEra era)
-> Maybe (ShelleyBasedEra era)
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> (eon era -> a) -> Maybe a
forEraInEonMaybe CardanoEra era
cEra ShelleyBasedEra era -> ShelleyBasedEra era
forall a. a -> a
id of
            Maybe (ShelleyBasedEra era)
Nothing -> QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> QueryCmdError
QueryCmdEraNotSupported AnyCardanoEra
anyCEra
            Just ShelleyBasedEra era
sbe -> do
              UTxO era
utxo <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (UTxO era)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
forall era block point r.
ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
queryUtxo ShelleyBasedEra era
sbe QueryUTxOFilter
queryFilter)
              (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> Maybe (File () 'Out)
-> UTxO era
-> ExceptT QueryCmdError IO ()
forall era.
ShelleyBasedEra era
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> Maybe (File () 'Out)
-> UTxO era
-> ExceptT QueryCmdError IO ()
writeFilteredUTxOs ShelleyBasedEra era
sbe Vary
  '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile UTxO era
utxo
      )
      RIO e (Either QueryCmdError ())
-> (RIO e (Either QueryCmdError ()) -> RIO e ()) -> RIO e ()
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError ()) -> RIO e ()
CIO e (Either QueryCmdError ()) -> CIO e ()
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

runQueryKesPeriodInfoCmd
  :: ()
  => Cmd.QueryKesPeriodInfoCmdArgs
  -> CIO e ()
runQueryKesPeriodInfoCmd :: forall e. QueryKesPeriodInfoCmdArgs -> CIO e ()
runQueryKesPeriodInfoCmd
  Cmd.QueryKesPeriodInfoCmdArgs
    { commons :: QueryKesPeriodInfoCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , File () 'In
nodeOpCertFp :: File () 'In
nodeOpCertFp :: QueryKesPeriodInfoCmdArgs -> File () 'In
Cmd.nodeOpCertFp
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: QueryKesPeriodInfoCmdArgs -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryKesPeriodInfoCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    OperationalCertificate
opCert <-
      IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> RIO e OperationalCertificate
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError TextEnvelopeError) OperationalCertificate)
 -> RIO e OperationalCertificate)
-> IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> RIO e OperationalCertificate
forall a b. (a -> b) -> a -> b
$ File () 'In
-> IO (Either (FileError TextEnvelopeError) OperationalCertificate)
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope File () 'In
nodeOpCertFp

    ByteString
output <-
      IO (Either AcquiringFailure (Either QueryCmdError ByteString))
-> RIO e (Either QueryCmdError ByteString)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError ByteString)
-> IO (Either AcquiringFailure (Either QueryCmdError ByteString))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError ByteString)
 -> IO (Either AcquiringFailure (Either QueryCmdError ByteString)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError ByteString)
-> IO (Either AcquiringFailure (Either QueryCmdError ByteString))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ByteString
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError ByteString)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ByteString
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError ByteString))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ByteString
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError ByteString)
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra
            let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
            -- We check that the KES period specified in the operational certificate is correct
            -- based on the KES period defined in the genesis parameters and the current slot number
            GenesisParameters ShelleyEra
gParams <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (GenesisParameters ShelleyEra)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (GenesisParameters ShelleyEra)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GenesisParameters ShelleyEra)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GenesisParameters ShelleyEra)))
queryGenesisParameters ShelleyBasedEra era
sbe)

            EraHistory
eraHistory <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  EraHistory
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  EraHistory
easyRunQueryEraHistory

            let eInfo :: Tentative (EpochInfo (Either Text))
eInfo = EraHistory -> Tentative (EpochInfo (Either Text))
toTentativeEpochInfo EraHistory
eraHistory

            -- We get the operational certificate counter from the protocol state and check that
            -- it is equivalent to what we have on disk.
            ProtocolState era
ptclState <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (ProtocolState era)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ProtocolState era)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ProtocolState era)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ProtocolState era)))
queryProtocolState ShelleyBasedEra era
sbe)

            ChainTip
chainTip <- IO ChainTip
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainTip
forall a.
IO a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainTip
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ChainTip)
-> IO ChainTip
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo -> IO ChainTip
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo -> m ChainTip
getLocalChainTip LocalNodeConnectInfo
nodeConnInfo

            let curKesPeriod :: CurrentKesPeriod
curKesPeriod = ChainTip -> GenesisParameters ShelleyEra -> CurrentKesPeriod
forall era. ChainTip -> GenesisParameters era -> CurrentKesPeriod
currentKesPeriod ChainTip
chainTip GenesisParameters ShelleyEra
gParams
                oCertStartKesPeriod :: OpCertStartingKesPeriod
oCertStartKesPeriod = OperationalCertificate -> OpCertStartingKesPeriod
opCertStartingKesPeriod OperationalCertificate
opCert
                oCertEndKesPeriod :: OpCertEndingKesPeriod
oCertEndKesPeriod = GenesisParameters ShelleyEra
-> OperationalCertificate -> OpCertEndingKesPeriod
forall era.
GenesisParameters era
-> OperationalCertificate -> OpCertEndingKesPeriod
opCertEndKesPeriod GenesisParameters ShelleyEra
gParams OperationalCertificate
opCert
                opCertIntervalInformation :: OpCertIntervalInformation
opCertIntervalInformation = GenesisParameters ShelleyEra
-> ChainTip
-> CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> OpCertIntervalInformation
forall era.
GenesisParameters era
-> ChainTip
-> CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> OpCertIntervalInformation
opCertIntervalInfo GenesisParameters ShelleyEra
gParams ChainTip
chainTip CurrentKesPeriod
curKesPeriod OpCertStartingKesPeriod
oCertStartKesPeriod OpCertEndingKesPeriod
oCertEndKesPeriod

            (OpCertOnDiskCounter
onDiskC, Maybe OpCertNodeStateCounter
stateC) <-
              Era era
-> (EraCommonConstraints era =>
    ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  ExceptT
    QueryCmdError
    (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
    (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> (EraCommonConstraints era =>
    ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a b. (a -> b) -> a -> b
$
                (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT
   QueryCmdError
   IO
   (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a b. (a -> b) -> a -> b
$
                  ProtocolState era
-> OperationalCertificate
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall era.
(PraosProtocolSupportsNode (ConsensusProtocol era),
 FromCBOR (ChainDepState (ConsensusProtocol era))) =>
ProtocolState era
-> OperationalCertificate
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
opCertOnDiskAndStateCounters ProtocolState era
ptclState OperationalCertificate
opCert

            let counterInformation :: OpCertNodeAndOnDiskCounterInformation
counterInformation = OpCertOnDiskCounter
-> Maybe OpCertNodeStateCounter
-> OpCertNodeAndOnDiskCounterInformation
opCertNodeAndOnDiskCounters OpCertOnDiskCounter
onDiskC Maybe OpCertNodeStateCounter
stateC

            -- Always render diagnostic information
            IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a.
IO a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> (FilePath -> IO ())
-> FilePath
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
putStrLn (FilePath
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> FilePath
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$
              Doc AnsiStyle -> FilePath
docToString (Doc AnsiStyle -> FilePath) -> Doc AnsiStyle -> FilePath
forall a b. (a -> b) -> a -> b
$
                FilePath -> OpCertIntervalInformation -> Doc AnsiStyle
renderOpCertIntervalInformation (File () 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File () 'In
nodeOpCertFp) OpCertIntervalInformation
opCertIntervalInformation

            IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a.
IO a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> (FilePath -> IO ())
-> FilePath
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
putStrLn (FilePath
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> FilePath
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$
              Doc AnsiStyle -> FilePath
docToString (Doc AnsiStyle -> FilePath) -> Doc AnsiStyle -> FilePath
forall a b. (a -> b) -> a -> b
$
                FilePath -> OpCertNodeAndOnDiskCounterInformation -> Doc AnsiStyle
renderOpCertNodeAndOnDiskCounterInformation (File () 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File () 'In
nodeOpCertFp) OpCertNodeAndOnDiskCounterInformation
counterInformation

            let qKesInfoOutput :: QueryKesPeriodInfoOutput
qKesInfoOutput = OpCertIntervalInformation
-> OpCertNodeAndOnDiskCounterInformation
-> Tentative (EpochInfo (Either Text))
-> GenesisParameters ShelleyEra
-> QueryKesPeriodInfoOutput
forall era.
OpCertIntervalInformation
-> OpCertNodeAndOnDiskCounterInformation
-> Tentative (EpochInfo (Either Text))
-> GenesisParameters era
-> QueryKesPeriodInfoOutput
createQueryKesPeriodInfoOutput OpCertIntervalInformation
opCertIntervalInformation OpCertNodeAndOnDiskCounterInformation
counterInformation Tentative (EpochInfo (Either Text))
eInfo GenesisParameters ShelleyEra
gParams

            ByteString
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ByteString
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (m :: * -> *) a. Monad m => a -> m a
return
              (ByteString
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ByteString)
-> ByteString
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[FormatJson, FormatYaml]
outputFormat
                Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> QueryKesPeriodInfoOutput -> ByteString)
-> QueryKesPeriodInfoOutput
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> QueryKesPeriodInfoOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> QueryKesPeriodInfoOutput
-> ByteString
forall a. a -> a
id
                      ((Vary '[FormatJson, FormatYaml]
  -> QueryKesPeriodInfoOutput -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> QueryKesPeriodInfoOutput
 -> ByteString)
-> ((Vary '[] -> QueryKesPeriodInfoOutput -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> QueryKesPeriodInfoOutput
    -> ByteString)
-> (Vary '[] -> QueryKesPeriodInfoOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> QueryKesPeriodInfoOutput
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> QueryKesPeriodInfoOutput -> ByteString)
-> (Vary '[FormatYaml] -> QueryKesPeriodInfoOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> QueryKesPeriodInfoOutput
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> QueryKesPeriodInfoOutput -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                      ((Vary '[FormatYaml] -> QueryKesPeriodInfoOutput -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> QueryKesPeriodInfoOutput
 -> ByteString)
-> ((Vary '[] -> QueryKesPeriodInfoOutput -> ByteString)
    -> Vary '[FormatYaml] -> QueryKesPeriodInfoOutput -> ByteString)
-> (Vary '[] -> QueryKesPeriodInfoOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> QueryKesPeriodInfoOutput
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> QueryKesPeriodInfoOutput -> ByteString)
-> (Vary '[] -> QueryKesPeriodInfoOutput -> ByteString)
-> Vary '[FormatYaml]
-> QueryKesPeriodInfoOutput
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> QueryKesPeriodInfoOutput -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                      ((Vary '[] -> QueryKesPeriodInfoOutput -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> QueryKesPeriodInfoOutput
 -> ByteString)
-> (Vary '[] -> QueryKesPeriodInfoOutput -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> QueryKesPeriodInfoOutput
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> QueryKesPeriodInfoOutput -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
                  )
              (QueryKesPeriodInfoOutput -> ByteString)
-> QueryKesPeriodInfoOutput -> ByteString
forall a b. (a -> b) -> a -> b
$ QueryKesPeriodInfoOutput
qKesInfoOutput
        )
        RIO e (Either QueryCmdError ByteString)
-> (RIO e (Either QueryCmdError ByteString) -> RIO e ByteString)
-> RIO e ByteString
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError ByteString) -> RIO e ByteString
CIO e (Either QueryCmdError ByteString) -> CIO e ByteString
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output
   where
    currentKesPeriod :: ChainTip -> GenesisParameters era -> CurrentKesPeriod
    currentKesPeriod :: forall era. ChainTip -> GenesisParameters era -> CurrentKesPeriod
currentKesPeriod ChainTip
ChainTipAtGenesis GenesisParameters era
_ = Word64 -> CurrentKesPeriod
CurrentKesPeriod Word64
0
    currentKesPeriod (ChainTip SlotNo
currSlot Hash BlockHeader
_ BlockNo
_) GenesisParameters era
gParams =
      let slotsPerKesPeriod :: Word64
slotsPerKesPeriod = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ GenesisParameters era -> Int
forall era. GenesisParameters era -> Int
protocolParamSlotsPerKESPeriod GenesisParameters era
gParams
       in Word64 -> CurrentKesPeriod
CurrentKesPeriod (Word64 -> CurrentKesPeriod) -> Word64 -> CurrentKesPeriod
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
currSlot Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
slotsPerKesPeriod

    opCertStartingKesPeriod :: OperationalCertificate -> OpCertStartingKesPeriod
    opCertStartingKesPeriod :: OperationalCertificate -> OpCertStartingKesPeriod
opCertStartingKesPeriod = Word64 -> OpCertStartingKesPeriod
OpCertStartingKesPeriod (Word64 -> OpCertStartingKesPeriod)
-> (OperationalCertificate -> Word64)
-> OperationalCertificate
-> OpCertStartingKesPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64)
-> (OperationalCertificate -> Word)
-> OperationalCertificate
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationalCertificate -> Word
getKesPeriod

    opCertEndKesPeriod :: GenesisParameters era -> OperationalCertificate -> OpCertEndingKesPeriod
    opCertEndKesPeriod :: forall era.
GenesisParameters era
-> OperationalCertificate -> OpCertEndingKesPeriod
opCertEndKesPeriod GenesisParameters era
gParams OperationalCertificate
oCert =
      let OpCertStartingKesPeriod Word64
start = OperationalCertificate -> OpCertStartingKesPeriod
opCertStartingKesPeriod OperationalCertificate
oCert
          maxKesEvo :: Word64
maxKesEvo = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ GenesisParameters era -> Int
forall era. GenesisParameters era -> Int
protocolParamMaxKESEvolutions GenesisParameters era
gParams
       in Word64 -> OpCertEndingKesPeriod
OpCertEndingKesPeriod (Word64 -> OpCertEndingKesPeriod)
-> Word64 -> OpCertEndingKesPeriod
forall a b. (a -> b) -> a -> b
$ Word64
start Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
maxKesEvo

    -- See OCERT rule in Shelley Spec: https://hydra.iohk.io/job/Cardano/cardano-ledger-specs/shelleyLedgerSpec/latest/download-by-type/doc-pdf/ledger-spec
    opCertIntervalInfo
      :: GenesisParameters era
      -> ChainTip
      -> CurrentKesPeriod
      -> OpCertStartingKesPeriod
      -> OpCertEndingKesPeriod
      -> OpCertIntervalInformation
    opCertIntervalInfo :: forall era.
GenesisParameters era
-> ChainTip
-> CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> OpCertIntervalInformation
opCertIntervalInfo GenesisParameters era
gParams ChainTip
currSlot' CurrentKesPeriod
c OpCertStartingKesPeriod
s e :: OpCertEndingKesPeriod
e@(OpCertEndingKesPeriod Word64
oCertEnd) =
      let cSlot :: Word64
cSlot = case ChainTip
currSlot' of
            (ChainTip SlotNo
cSlotN Hash BlockHeader
_ BlockNo
_) -> SlotNo -> Word64
unSlotNo SlotNo
cSlotN
            ChainTip
ChainTipAtGenesis -> Word64
0
          slotsTillExp :: SlotsTillKesKeyExpiry
slotsTillExp =
            SlotNo -> SlotsTillKesKeyExpiry
SlotsTillKesKeyExpiry (SlotNo -> SlotsTillKesKeyExpiry)
-> (Word64 -> SlotNo) -> Word64 -> SlotsTillKesKeyExpiry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo (Word64 -> SlotsTillKesKeyExpiry)
-> Word64 -> SlotsTillKesKeyExpiry
forall a b. (a -> b) -> a -> b
$
              (Word64
oCertEnd Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenesisParameters era -> Int
forall era. GenesisParameters era -> Int
protocolParamSlotsPerKESPeriod GenesisParameters era
gParams)) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
cSlot
       in CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> Maybe SlotsTillKesKeyExpiry
-> OpCertIntervalInformation
O.createOpCertIntervalInfo CurrentKesPeriod
c OpCertStartingKesPeriod
s OpCertEndingKesPeriod
e (SlotsTillKesKeyExpiry -> Maybe SlotsTillKesKeyExpiry
forall a. a -> Maybe a
Just SlotsTillKesKeyExpiry
slotsTillExp)

    opCertNodeAndOnDiskCounters
      :: OpCertOnDiskCounter
      -> Maybe OpCertNodeStateCounter
      -> OpCertNodeAndOnDiskCounterInformation
    opCertNodeAndOnDiskCounters :: OpCertOnDiskCounter
-> Maybe OpCertNodeStateCounter
-> OpCertNodeAndOnDiskCounterInformation
opCertNodeAndOnDiskCounters o :: OpCertOnDiskCounter
o@(OpCertOnDiskCounter Word64
odc) (Just n :: OpCertNodeStateCounter
n@(OpCertNodeStateCounter Word64
nsc))
      | Word64
odc Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
nsc = OpCertOnDiskCounter
-> OpCertNodeStateCounter -> OpCertNodeAndOnDiskCounterInformation
OpCertOnDiskCounterBehindNodeState OpCertOnDiskCounter
o OpCertNodeStateCounter
n
      | Word64
odc Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
nsc Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1 = OpCertOnDiskCounter
-> OpCertNodeStateCounter -> OpCertNodeAndOnDiskCounterInformation
OpCertOnDiskCounterTooFarAheadOfNodeState OpCertOnDiskCounter
o OpCertNodeStateCounter
n
      | Word64
odc Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
nsc Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1 = OpCertOnDiskCounter
-> OpCertNodeStateCounter -> OpCertNodeAndOnDiskCounterInformation
OpCertOnDiskCounterAheadOfNodeState OpCertOnDiskCounter
o OpCertNodeStateCounter
n
      | Bool
otherwise = OpCertOnDiskCounter
-> OpCertNodeStateCounter -> OpCertNodeAndOnDiskCounterInformation
OpCertOnDiskCounterEqualToNodeState OpCertOnDiskCounter
o OpCertNodeStateCounter
n
    opCertNodeAndOnDiskCounters OpCertOnDiskCounter
o Maybe OpCertNodeStateCounter
Nothing = OpCertOnDiskCounter -> OpCertNodeAndOnDiskCounterInformation
OpCertNoBlocksMintedYet OpCertOnDiskCounter
o

    opCertExpiryUtcTime
      :: Tentative (EpochInfo (Either Text))
      -> GenesisParameters era
      -> OpCertEndingKesPeriod
      -> Maybe UTCTime
    opCertExpiryUtcTime :: forall era.
Tentative (EpochInfo (Either Text))
-> GenesisParameters era -> OpCertEndingKesPeriod -> Maybe UTCTime
opCertExpiryUtcTime Tentative (EpochInfo (Either Text))
eInfo GenesisParameters era
gParams (OpCertEndingKesPeriod Word64
oCertExpiryKesPeriod) =
      let time :: Either Text UTCTime
time =
            EpochInfo (Either Text)
-> SystemStart -> SlotNo -> Either Text UTCTime
forall (m :: * -> *).
(HasCallStack, Monad m) =>
EpochInfo m -> SystemStart -> SlotNo -> m UTCTime
epochInfoSlotToUTCTime
              (Tentative (EpochInfo (Either Text)) -> EpochInfo (Either Text)
forall a. Tentative a -> a
tentative Tentative (EpochInfo (Either Text))
eInfo)
              (UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ GenesisParameters era -> UTCTime
forall era. GenesisParameters era -> UTCTime
protocolParamSystemStart GenesisParameters era
gParams)
              (Word64 -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Word64
oCertExpiryKesPeriod Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenesisParameters era -> Int
forall era. GenesisParameters era -> Int
protocolParamSlotsPerKESPeriod GenesisParameters era
gParams))
       in case Either Text UTCTime
time of
            Left Text
_ -> Maybe UTCTime
forall a. Maybe a
Nothing
            Right UTCTime
t -> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
t

    renderOpCertNodeAndOnDiskCounterInformation
      :: FilePath -> OpCertNodeAndOnDiskCounterInformation -> Doc AnsiStyle
    renderOpCertNodeAndOnDiskCounterInformation :: FilePath -> OpCertNodeAndOnDiskCounterInformation -> Doc AnsiStyle
renderOpCertNodeAndOnDiskCounterInformation FilePath
opCertFile = \case
      OpCertOnDiskCounterEqualToNodeState OpCertOnDiskCounter
_ OpCertNodeStateCounter
_ ->
        Doc AnsiStyle -> Doc AnsiStyle
green Doc AnsiStyle
"✓"
          Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
            Int
0
            ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc AnsiStyle
"The operational certificate counter agrees with the node protocol state counter"
                ]
            )
      OpCertOnDiskCounterAheadOfNodeState OpCertOnDiskCounter
_ OpCertNodeStateCounter
_ ->
        Doc AnsiStyle -> Doc AnsiStyle
green Doc AnsiStyle
"✓"
          Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
            Int
0
            ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc AnsiStyle
"The operational certificate counter ahead of the node protocol state counter by 1"
                ]
            )
      OpCertOnDiskCounterTooFarAheadOfNodeState OpCertOnDiskCounter
onDiskC OpCertNodeStateCounter
nodeStateC ->
        Doc AnsiStyle -> Doc AnsiStyle
red Doc AnsiStyle
"✗"
          Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
            Int
0
            ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc AnsiStyle
"The operational certificate counter too far ahead of the node protocol state counter in the operational certificate at: "
                    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc AnsiStyle
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
opCertFile
                , Doc AnsiStyle
"On disk operational certificate counter: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (OpCertOnDiskCounter -> Word64
unOpCertOnDiskCounter OpCertOnDiskCounter
onDiskC)
                , Doc AnsiStyle
"Protocol state counter: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (OpCertNodeStateCounter -> Word64
unOpCertNodeStateCounter OpCertNodeStateCounter
nodeStateC)
                ]
            )
      OpCertOnDiskCounterBehindNodeState OpCertOnDiskCounter
onDiskC OpCertNodeStateCounter
nodeStateC ->
        Doc AnsiStyle -> Doc AnsiStyle
red Doc AnsiStyle
"✗"
          Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
            Int
0
            ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc AnsiStyle
"The protocol state counter is greater than the counter in the operational certificate at: "
                    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc AnsiStyle
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
opCertFile
                , Doc AnsiStyle
"On disk operational certificate counter: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (OpCertOnDiskCounter -> Word64
unOpCertOnDiskCounter OpCertOnDiskCounter
onDiskC)
                , Doc AnsiStyle
"Protocol state counter: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (OpCertNodeStateCounter -> Word64
unOpCertNodeStateCounter OpCertNodeStateCounter
nodeStateC)
                ]
            )
      OpCertNoBlocksMintedYet (OpCertOnDiskCounter Word64
onDiskC) ->
        Doc AnsiStyle -> Doc AnsiStyle
red Doc AnsiStyle
"✗"
          Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
            Int
0
            ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc AnsiStyle
"No blocks minted so far with the operational certificate at: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc AnsiStyle
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
opCertFile
                , Doc AnsiStyle
"On disk operational certificate counter: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
onDiskC
                ]
            )

    createQueryKesPeriodInfoOutput
      :: OpCertIntervalInformation
      -> OpCertNodeAndOnDiskCounterInformation
      -> Tentative (EpochInfo (Either Text))
      -> GenesisParameters era
      -> O.QueryKesPeriodInfoOutput
    createQueryKesPeriodInfoOutput :: forall era.
OpCertIntervalInformation
-> OpCertNodeAndOnDiskCounterInformation
-> Tentative (EpochInfo (Either Text))
-> GenesisParameters era
-> QueryKesPeriodInfoOutput
createQueryKesPeriodInfoOutput OpCertIntervalInformation
oCertIntervalInfo OpCertNodeAndOnDiskCounterInformation
oCertCounterInfo Tentative (EpochInfo (Either Text))
eInfo GenesisParameters era
gParams =
      let (OpCertEndingKesPeriod
e, Maybe SlotsTillKesKeyExpiry
mStillExp) = case OpCertIntervalInformation
oCertIntervalInfo of
            OpCertWithinInterval OpCertStartingKesPeriod
_ OpCertEndingKesPeriod
end CurrentKesPeriod
_ SlotsTillKesKeyExpiry
sTillExp -> (OpCertEndingKesPeriod
end, SlotsTillKesKeyExpiry -> Maybe SlotsTillKesKeyExpiry
forall a. a -> Maybe a
Just SlotsTillKesKeyExpiry
sTillExp)
            OpCertStartingKesPeriodIsInTheFuture OpCertStartingKesPeriod
_ OpCertEndingKesPeriod
end CurrentKesPeriod
_ -> (OpCertEndingKesPeriod
end, Maybe SlotsTillKesKeyExpiry
forall a. Maybe a
Nothing)
            OpCertExpired OpCertStartingKesPeriod
_ OpCertEndingKesPeriod
end CurrentKesPeriod
_ -> (OpCertEndingKesPeriod
end, Maybe SlotsTillKesKeyExpiry
forall a. Maybe a
Nothing)
            OpCertSomeOtherError OpCertStartingKesPeriod
_ OpCertEndingKesPeriod
end CurrentKesPeriod
_ -> (OpCertEndingKesPeriod
end, Maybe SlotsTillKesKeyExpiry
forall a. Maybe a
Nothing)
          (OpCertOnDiskCounter
onDiskCounter, Maybe OpCertNodeStateCounter
mNodeCounter) = case OpCertNodeAndOnDiskCounterInformation
oCertCounterInfo of
            OpCertOnDiskCounterEqualToNodeState OpCertOnDiskCounter
d OpCertNodeStateCounter
n -> (OpCertOnDiskCounter
d, OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter
forall a. a -> Maybe a
Just OpCertNodeStateCounter
n)
            OpCertOnDiskCounterAheadOfNodeState OpCertOnDiskCounter
d OpCertNodeStateCounter
n -> (OpCertOnDiskCounter
d, OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter
forall a. a -> Maybe a
Just OpCertNodeStateCounter
n)
            OpCertOnDiskCounterTooFarAheadOfNodeState OpCertOnDiskCounter
d OpCertNodeStateCounter
n -> (OpCertOnDiskCounter
d, OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter
forall a. a -> Maybe a
Just OpCertNodeStateCounter
n)
            OpCertOnDiskCounterBehindNodeState OpCertOnDiskCounter
d OpCertNodeStateCounter
n -> (OpCertOnDiskCounter
d, OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter
forall a. a -> Maybe a
Just OpCertNodeStateCounter
n)
            OpCertNoBlocksMintedYet OpCertOnDiskCounter
d -> (OpCertOnDiskCounter
d, Maybe OpCertNodeStateCounter
forall a. Maybe a
Nothing)
       in O.QueryKesPeriodInfoOutput
            { qKesOpCertIntervalInformation :: OpCertIntervalInformation
O.qKesOpCertIntervalInformation = OpCertIntervalInformation
oCertIntervalInfo
            , qKesInfoNodeStateOperationalCertNo :: Maybe OpCertNodeStateCounter
O.qKesInfoNodeStateOperationalCertNo = Maybe OpCertNodeStateCounter
mNodeCounter
            , qKesInfoOnDiskOperationalCertNo :: OpCertOnDiskCounter
O.qKesInfoOnDiskOperationalCertNo = OpCertOnDiskCounter
onDiskCounter
            , qKesInfoMaxKesKeyEvolutions :: Word64
O.qKesInfoMaxKesKeyEvolutions = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ GenesisParameters era -> Int
forall era. GenesisParameters era -> Int
protocolParamMaxKESEvolutions GenesisParameters era
gParams
            , qKesInfoSlotsPerKesPeriod :: Word64
O.qKesInfoSlotsPerKesPeriod = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ GenesisParameters era -> Int
forall era. GenesisParameters era -> Int
protocolParamSlotsPerKESPeriod GenesisParameters era
gParams
            , qKesInfoKesKeyExpiry :: Maybe UTCTime
O.qKesInfoKesKeyExpiry =
                case Maybe SlotsTillKesKeyExpiry
mStillExp of
                  Just SlotsTillKesKeyExpiry
_ -> Tentative (EpochInfo (Either Text))
-> GenesisParameters era -> OpCertEndingKesPeriod -> Maybe UTCTime
forall era.
Tentative (EpochInfo (Either Text))
-> GenesisParameters era -> OpCertEndingKesPeriod -> Maybe UTCTime
opCertExpiryUtcTime Tentative (EpochInfo (Either Text))
eInfo GenesisParameters era
gParams OpCertEndingKesPeriod
e
                  Maybe SlotsTillKesKeyExpiry
Nothing -> Maybe UTCTime
forall a. Maybe a
Nothing
            }

    -- We get the operational certificate counter from the protocol state and check that
    -- it is equivalent to what we have on disk.
    opCertOnDiskAndStateCounters
      :: forall era
       . ()
      => Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
      => FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
      => ProtocolState era
      -> OperationalCertificate
      -> ExceptT QueryCmdError IO (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
    opCertOnDiskAndStateCounters :: forall era.
(PraosProtocolSupportsNode (ConsensusProtocol era),
 FromCBOR (ChainDepState (ConsensusProtocol era))) =>
ProtocolState era
-> OperationalCertificate
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
opCertOnDiskAndStateCounters ProtocolState era
ptclState opCert :: OperationalCertificate
opCert@(OperationalCertificate OCert StandardCrypto
_ VerificationKey StakePoolKey
stakePoolVKey) = do
      let onDiskOpCertCount :: Word64
onDiskOpCertCount = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ OperationalCertificate -> Word64
getOpCertCount OperationalCertificate
opCert

      ChainDepState (ConsensusProtocol era)
chainDepState <-
        Either
  (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era))
-> ExceptT
     QueryCmdError
     IO
     (Either
        (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)))
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProtocolState era
-> Either
     (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era))
forall era.
FromCBOR (ChainDepState (ConsensusProtocol era)) =>
ProtocolState era
-> Either
     (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era))
decodeProtocolState ProtocolState era
ptclState)
          ExceptT
  QueryCmdError
  IO
  (Either
     (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)))
    -> ExceptT
         QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall a b. a -> (a -> b) -> b
& ((ByteString, DecoderError)
 -> ExceptT
      QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ExceptT
     QueryCmdError
     IO
     (Either
        (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)))
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ((ByteString, DecoderError) -> QueryCmdError)
-> (ByteString, DecoderError)
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, DecoderError) -> QueryCmdError
QueryCmdProtocolStateDecodeFailure)

      -- We need the stake pool id to determine what the counter of our SPO
      -- should be.
      let opCertCounterMap :: Map (KeyHash 'BlockIssuer) Word64
opCertCounterMap = Proxy (ConsensusProtocol era)
-> ChainDepState (ConsensusProtocol era)
-> Map (KeyHash 'BlockIssuer) Word64
forall p (proxy :: * -> *).
PraosProtocolSupportsNode p =>
proxy p -> ChainDepState p -> Map (KeyHash 'BlockIssuer) Word64
forall (proxy :: * -> *).
proxy (ConsensusProtocol era)
-> ChainDepState (ConsensusProtocol era)
-> Map (KeyHash 'BlockIssuer) Word64
Consensus.getOpCertCounters (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ConsensusProtocol era)) ChainDepState (ConsensusProtocol era)
chainDepState
          StakePoolKeyHash KeyHash 'StakePool
blockIssuerHash =
            VerificationKey StakePoolKey -> PoolId
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVKey

      case KeyHash 'BlockIssuer
-> Map (KeyHash 'BlockIssuer) Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (KeyHash 'StakePool -> KeyHash 'BlockIssuer
forall a b. Coercible a b => a -> b
coerce KeyHash 'StakePool
blockIssuerHash) Map (KeyHash 'BlockIssuer) Word64
opCertCounterMap of
        -- Operational certificate exists in the protocol state
        -- so our ondisk op cert counter must be greater than or
        -- equal to what is in the node state.
        Just Word64
ptclStateCounter -> (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a. a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> OpCertOnDiskCounter
OpCertOnDiskCounter Word64
onDiskOpCertCount, OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter
forall a. a -> Maybe a
Just (OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter)
-> OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter
forall a b. (a -> b) -> a -> b
$ Word64 -> OpCertNodeStateCounter
OpCertNodeStateCounter Word64
ptclStateCounter)
        Maybe Word64
Nothing -> (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a. a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> OpCertOnDiskCounter
OpCertOnDiskCounter Word64
onDiskOpCertCount, Maybe OpCertNodeStateCounter
forall a. Maybe a
Nothing)

renderOpCertIntervalInformation :: FilePath -> OpCertIntervalInformation -> Doc AnsiStyle
renderOpCertIntervalInformation :: FilePath -> OpCertIntervalInformation -> Doc AnsiStyle
renderOpCertIntervalInformation FilePath
opCertFile OpCertIntervalInformation
opCertInfo = case OpCertIntervalInformation
opCertInfo of
  OpCertWithinInterval OpCertStartingKesPeriod
_start OpCertEndingKesPeriod
_end CurrentKesPeriod
_current SlotsTillKesKeyExpiry
_stillExp ->
    Doc AnsiStyle -> Doc AnsiStyle
green Doc AnsiStyle
"✓"
      Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
        Int
0
        ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
            [ Doc AnsiStyle
"Operational certificate's KES period is within the correct KES period interval"
            ]
        )
  OpCertStartingKesPeriodIsInTheFuture
    (OpCertStartingKesPeriod Word64
start)
    (OpCertEndingKesPeriod Word64
end)
    (CurrentKesPeriod Word64
current) ->
      Doc AnsiStyle -> Doc AnsiStyle
red Doc AnsiStyle
"✗"
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
          Int
0
          ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
              [ Doc AnsiStyle
"Node operational certificate at: "
                  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc AnsiStyle
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
opCertFile
                  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
" has an incorrectly specified starting KES period. "
              , Doc AnsiStyle
"Current KES period: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
current
              , Doc AnsiStyle
"Operational certificate's starting KES period: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
start
              , Doc AnsiStyle
"Operational certificate's expiry KES period: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
end
              ]
          )
  OpCertExpired OpCertStartingKesPeriod
_ (OpCertEndingKesPeriod Word64
end) (CurrentKesPeriod Word64
current) ->
    Doc AnsiStyle -> Doc AnsiStyle
red Doc AnsiStyle
"✗"
      Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
        Int
0
        ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
            [ Doc AnsiStyle
"Node operational certificate at: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc AnsiStyle
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
opCertFile Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
" has expired. "
            , Doc AnsiStyle
"Current KES period: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
current
            , Doc AnsiStyle
"Operational certificate's expiry KES period: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
end
            ]
        )
  OpCertSomeOtherError
    (OpCertStartingKesPeriod Word64
start)
    (OpCertEndingKesPeriod Word64
end)
    (CurrentKesPeriod Word64
current) ->
      Doc AnsiStyle -> Doc AnsiStyle
red Doc AnsiStyle
"✗"
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
hang
          Int
0
          ( [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
              [ Doc AnsiStyle
"An unknown error occurred with operational certificate at: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc AnsiStyle
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
opCertFile
              , Doc AnsiStyle
"Current KES period: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
current
              , Doc AnsiStyle
"Operational certificate's starting KES period: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
start
              , Doc AnsiStyle
"Operational certificate's expiry KES period: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc AnsiStyle
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
end
              ]
          )

-- | Query the current and future parameters for a stake pool, including the retirement date.
-- Any of these may be empty (in which case a null will be displayed).
runQueryPoolStateCmd
  :: ()
  => Cmd.QueryPoolStateCmdArgs
  -> CIO e ()
runQueryPoolStateCmd :: forall e. QueryPoolStateCmdArgs -> CIO e ()
runQueryPoolStateCmd
  Cmd.QueryPoolStateCmdArgs
    { commons :: QueryPoolStateCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , AllOrOnly PoolId
allOrOnlyPoolIds :: AllOrOnly PoolId
allOrOnlyPoolIds :: QueryPoolStateCmdArgs -> AllOrOnly PoolId
Cmd.allOrOnlyPoolIds
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: QueryPoolStateCmdArgs -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryPoolStateCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    IO (Either AcquiringFailure (Either QueryCmdError ()))
-> RIO e (Either QueryCmdError ())
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
      ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
 -> IO (Either AcquiringFailure (Either QueryCmdError ())))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ()
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ()))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$ do
          AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra

          let beo :: BabbageEraOnwards era
beo = Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
              poolFilter :: Maybe (Set PoolId)
poolFilter = case AllOrOnly PoolId
allOrOnlyPoolIds of
                AllOrOnly PoolId
All -> Maybe (Set PoolId)
forall a. Maybe a
Nothing
                Only [PoolId]
poolIds -> Set PoolId -> Maybe (Set PoolId)
forall a. a -> Maybe a
Just (Set PoolId -> Maybe (Set PoolId))
-> Set PoolId -> Maybe (Set PoolId)
forall a b. (a -> b) -> a -> b
$ [Item (Set PoolId)] -> Set PoolId
forall l. IsList l => [Item l] -> l
fromList [Item (Set PoolId)]
[PoolId]
poolIds

          SerialisedPoolState
result <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch SerialisedPoolState))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SerialisedPoolState
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch SerialisedPoolState))
forall era block point r.
BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch SerialisedPoolState))
queryPoolState BabbageEraOnwards era
beo Maybe (Set PoolId)
poolFilter)
          (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$ Era era
-> Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> SerialisedPoolState
-> ExceptT QueryCmdError IO ()
forall era.
Era era
-> Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> SerialisedPoolState
-> ExceptT QueryCmdError IO ()
writePoolState Era era
era Vary '[FormatJson, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile SerialisedPoolState
result
      )
      RIO e (Either QueryCmdError ())
-> (RIO e (Either QueryCmdError ()) -> RIO e ()) -> RIO e ()
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError ()) -> RIO e ()
CIO e (Either QueryCmdError ()) -> CIO e ()
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

-- | Query the local mempool state
runQueryTxMempoolCmd
  :: ()
  => Cmd.QueryTxMempoolCmdArgs
  -> CIO e ()
runQueryTxMempoolCmd :: forall e. QueryTxMempoolCmdArgs -> CIO e ()
runQueryTxMempoolCmd
  Cmd.QueryTxMempoolCmdArgs
    { LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
nodeConnInfo :: QueryTxMempoolCmdArgs -> LocalNodeConnectInfo
Cmd.nodeConnInfo
    , TxMempoolQuery
query :: TxMempoolQuery
query :: QueryTxMempoolCmdArgs -> TxMempoolQuery
Cmd.query
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: QueryTxMempoolCmdArgs -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryTxMempoolCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    LocalTxMonitoringQuery
localQuery <- case TxMempoolQuery
query of
      TxMempoolQueryTxExists TxId
tx -> do
        AnyCardanoEra CardanoEra era
era <-
          ExceptT AcquiringFailure IO AnyCardanoEra -> RIO e AnyCardanoEra
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT AcquiringFailure IO AnyCardanoEra -> RIO e AnyCardanoEra)
-> ExceptT AcquiringFailure IO AnyCardanoEra -> RIO e AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo -> ExceptT AcquiringFailure IO AnyCardanoEra
determineEra LocalNodeConnectInfo
nodeConnInfo
        LocalTxMonitoringQuery -> RIO e LocalTxMonitoringQuery
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalTxMonitoringQuery -> RIO e LocalTxMonitoringQuery)
-> LocalTxMonitoringQuery -> RIO e LocalTxMonitoringQuery
forall a b. (a -> b) -> a -> b
$ TxIdInMode -> LocalTxMonitoringQuery
LocalTxMonitoringQueryTx (TxIdInMode -> LocalTxMonitoringQuery)
-> TxIdInMode -> LocalTxMonitoringQuery
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> TxId -> TxIdInMode
forall era. CardanoEra era -> TxId -> TxIdInMode
TxIdInMode CardanoEra era
era TxId
tx
      TxMempoolQuery
TxMempoolQueryNextTx -> LocalTxMonitoringQuery -> RIO e LocalTxMonitoringQuery
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTxMonitoringQuery
LocalTxMonitoringSendNextTx
      TxMempoolQuery
TxMempoolQueryInfo -> LocalTxMonitoringQuery -> RIO e LocalTxMonitoringQuery
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTxMonitoringQuery
LocalTxMonitoringMempoolInformation

    LocalTxMonitoringResult
result <- IO LocalTxMonitoringResult -> RIO e LocalTxMonitoringResult
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LocalTxMonitoringResult -> RIO e LocalTxMonitoringResult)
-> IO LocalTxMonitoringResult -> RIO e LocalTxMonitoringResult
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> LocalTxMonitoringQuery -> IO LocalTxMonitoringResult
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo
-> LocalTxMonitoringQuery -> m LocalTxMonitoringResult
queryTxMonitoringLocal LocalNodeConnectInfo
nodeConnInfo LocalTxMonitoringQuery
localQuery

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> LocalTxMonitoringResult -> ByteString)
-> LocalTxMonitoringResult
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> LocalTxMonitoringResult -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LocalTxMonitoringResult
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> LocalTxMonitoringResult -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> LocalTxMonitoringResult
 -> ByteString)
-> ((Vary '[] -> LocalTxMonitoringResult -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> LocalTxMonitoringResult
    -> ByteString)
-> (Vary '[] -> LocalTxMonitoringResult -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LocalTxMonitoringResult
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> LocalTxMonitoringResult -> ByteString)
-> (Vary '[FormatYaml] -> LocalTxMonitoringResult -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LocalTxMonitoringResult
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> LocalTxMonitoringResult -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml] -> LocalTxMonitoringResult -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> LocalTxMonitoringResult
 -> ByteString)
-> ((Vary '[] -> LocalTxMonitoringResult -> ByteString)
    -> Vary '[FormatYaml] -> LocalTxMonitoringResult -> ByteString)
-> (Vary '[] -> LocalTxMonitoringResult -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LocalTxMonitoringResult
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> LocalTxMonitoringResult -> ByteString)
-> (Vary '[] -> LocalTxMonitoringResult -> ByteString)
-> Vary '[FormatYaml]
-> LocalTxMonitoringResult
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> LocalTxMonitoringResult -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> LocalTxMonitoringResult -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> LocalTxMonitoringResult
 -> ByteString)
-> (Vary '[] -> LocalTxMonitoringResult -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LocalTxMonitoringResult
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> LocalTxMonitoringResult -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (LocalTxMonitoringResult -> ByteString)
-> LocalTxMonitoringResult -> ByteString
forall a b. (a -> b) -> a -> b
$ LocalTxMonitoringResult
result

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQuerySlotNumberCmd
  :: ()
  => Cmd.QuerySlotNumberCmdArgs
  -> CIO e ()
runQuerySlotNumberCmd :: forall e. QuerySlotNumberCmdArgs -> CIO e ()
runQuerySlotNumberCmd
  Cmd.QuerySlotNumberCmdArgs
    { commons :: QuerySlotNumberCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , UTCTime
utcTime :: UTCTime
utcTime :: QuerySlotNumberCmdArgs -> UTCTime
Cmd.utcTime
    } = do
    SlotNo Word64
slotNo <- ExceptT QueryCmdError IO SlotNo -> RIO e SlotNo
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO SlotNo -> RIO e SlotNo)
-> ExceptT QueryCmdError IO SlotNo -> RIO e SlotNo
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint -> UTCTime -> ExceptT QueryCmdError IO SlotNo
utcTimeToSlotNo LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target UTCTime
utcTime
    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> (FilePath -> IO ()) -> FilePath -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
putStr (FilePath -> RIO e ()) -> FilePath -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Word64 -> FilePath
forall a. Show a => a -> FilePath
show Word64
slotNo

runQueryRefScriptSizeCmd
  :: forall e
   . Cmd.QueryRefScriptSizeCmdArgs
  -> CIO e ()
runQueryRefScriptSizeCmd :: forall e. QueryRefScriptSizeCmdArgs -> CIO e ()
runQueryRefScriptSizeCmd
  Cmd.QueryRefScriptSizeCmdArgs
    { commons :: QueryRefScriptSizeCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Set TxIn
transactionInputs :: Set TxIn
transactionInputs :: QueryRefScriptSizeCmdArgs -> Set TxIn
Cmd.transactionInputs
    , Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: QueryRefScriptSizeCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryRefScriptSizeCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    Either QueryCmdError ()
r <- IO (Either AcquiringFailure (Either QueryCmdError ()))
-> RIO e (Either QueryCmdError ())
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either AcquiringFailure (Either QueryCmdError ()))
 -> RIO e (Either QueryCmdError ()))
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
-> RIO e (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
 -> IO (Either AcquiringFailure (Either QueryCmdError ())))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ()
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ()))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$ do
      AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

      Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra

      let beo :: BabbageEraOnwards era
beo = Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
          sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era

      UTxO era
utxo <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (UTxO era)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
forall era block point r.
ShelleyBasedEra era
-> QueryUTxOFilter
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
queryUtxo ShelleyBasedEra era
sbe (QueryUTxOFilter
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either
         UnsupportedNtcVersionError (Either EraMismatch (UTxO era))))
-> QueryUTxOFilter
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch (UTxO era)))
forall a b. (a -> b) -> a -> b
$ Set TxIn -> QueryUTxOFilter
QueryUTxOByTxIn Set TxIn
transactionInputs)

      LocalStateQueryExpr
  BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$
        ()
-> RIO () (Either QueryCmdError ())
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO () (RIO () (Either QueryCmdError ())
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ()))
-> RIO () (Either QueryCmdError ())
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$
          RIO () (Either QueryCmdError ())
-> (FileError () -> RIO () (Either QueryCmdError ()))
-> RIO () (Either QueryCmdError ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
            ( (() -> Either QueryCmdError ())
-> RIO () () -> RIO () (Either QueryCmdError ())
forall a b. (a -> b) -> RIO () a -> RIO () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Either QueryCmdError ()
forall a b. b -> Either a b
Right (RIO () () -> RIO () (Either QueryCmdError ()))
-> RIO () () -> RIO () (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$
                Vary '[FormatJson, FormatText, FormatYaml]
-> Maybe (File () 'Out) -> RefInputScriptSize -> CIO () ()
forall a b e.
(ToJSON a, Pretty a) =>
Vary '[FormatJson, FormatText, FormatYaml]
-> Maybe (File b 'Out) -> a -> CIO e ()
writeFormattedOutput Vary '[FormatJson, FormatText, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile (RefInputScriptSize -> CIO () ())
-> RefInputScriptSize -> CIO () ()
forall a b. (a -> b) -> a -> b
$
                  Int -> RefInputScriptSize
RefInputScriptSize (Int -> RefInputScriptSize) -> Int -> RefInputScriptSize
forall a b. (a -> b) -> a -> b
$
                    BabbageEraOnwards era
-> UTxO (ShelleyLedgerEra era) -> Set TxIn -> Int
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera) =>
BabbageEraOnwards era -> UTxO ledgerera -> Set TxIn -> Int
getReferenceInputsSizeForTxIds BabbageEraOnwards era
beo (ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
sbe UTxO era
utxo) Set TxIn
transactionInputs
            )
            (Either QueryCmdError () -> RIO () (Either QueryCmdError ())
forall a. a -> RIO () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QueryCmdError () -> RIO () (Either QueryCmdError ()))
-> (FileError () -> Either QueryCmdError ())
-> FileError ()
-> RIO () (Either QueryCmdError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryCmdError -> Either QueryCmdError ()
forall a b. a -> Either a b
Left (QueryCmdError -> Either QueryCmdError ())
-> (FileError () -> QueryCmdError)
-> FileError ()
-> Either QueryCmdError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError () -> QueryCmdError
QueryCmdWriteFileError)
    Either QueryCmdError () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli Either QueryCmdError ()
r

newtype RefInputScriptSize = RefInputScriptSize {RefInputScriptSize -> Int
refInputScriptSize :: Int}
  deriving (forall x. RefInputScriptSize -> Rep RefInputScriptSize x)
-> (forall x. Rep RefInputScriptSize x -> RefInputScriptSize)
-> Generic RefInputScriptSize
forall x. Rep RefInputScriptSize x -> RefInputScriptSize
forall x. RefInputScriptSize -> Rep RefInputScriptSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RefInputScriptSize -> Rep RefInputScriptSize x
from :: forall x. RefInputScriptSize -> Rep RefInputScriptSize x
$cto :: forall x. Rep RefInputScriptSize x -> RefInputScriptSize
to :: forall x. Rep RefInputScriptSize x -> RefInputScriptSize
Generic
  deriving anyclass [RefInputScriptSize] -> Value
[RefInputScriptSize] -> Encoding
RefInputScriptSize -> Bool
RefInputScriptSize -> Value
RefInputScriptSize -> Encoding
(RefInputScriptSize -> Value)
-> (RefInputScriptSize -> Encoding)
-> ([RefInputScriptSize] -> Value)
-> ([RefInputScriptSize] -> Encoding)
-> (RefInputScriptSize -> Bool)
-> ToJSON RefInputScriptSize
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RefInputScriptSize -> Value
toJSON :: RefInputScriptSize -> Value
$ctoEncoding :: RefInputScriptSize -> Encoding
toEncoding :: RefInputScriptSize -> Encoding
$ctoJSONList :: [RefInputScriptSize] -> Value
toJSONList :: [RefInputScriptSize] -> Value
$ctoEncodingList :: [RefInputScriptSize] -> Encoding
toEncodingList :: [RefInputScriptSize] -> Encoding
$comitField :: RefInputScriptSize -> Bool
omitField :: RefInputScriptSize -> Bool
ToJSON

instance Pretty RefInputScriptSize where
  pretty :: forall ann. RefInputScriptSize -> Doc ann
pretty (RefInputScriptSize Int
s) = Doc ann
"Reference inputs scripts size is" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
s Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"bytes."

-- | Obtain stake snapshot information for a pool, plus information about the total active stake.
-- This information can be used for leader slot calculation, for example, and has been requested by SPOs.
-- Obtaining the information directly is significantly more time and memory efficient than using a full ledger state dump.
runQueryStakeSnapshotCmd
  :: ()
  => Cmd.QueryStakeSnapshotCmdArgs
  -> CIO e ()
runQueryStakeSnapshotCmd :: forall e. QueryStakeSnapshotCmdArgs -> CIO e ()
runQueryStakeSnapshotCmd
  Cmd.QueryStakeSnapshotCmdArgs
    { commons :: QueryStakeSnapshotCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , AllOrOnly PoolId
allOrOnlyPoolIds :: AllOrOnly PoolId
allOrOnlyPoolIds :: QueryStakeSnapshotCmdArgs -> AllOrOnly PoolId
Cmd.allOrOnlyPoolIds
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: QueryStakeSnapshotCmdArgs -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryStakeSnapshotCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    IO (Either AcquiringFailure (Either QueryCmdError ()))
-> RIO e (Either QueryCmdError ())
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
      ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
 -> IO (Either AcquiringFailure (Either QueryCmdError ())))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ()
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ()))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$ do
          AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra

          let poolFilter :: Maybe (Set PoolId)
poolFilter = case AllOrOnly PoolId
allOrOnlyPoolIds of
                AllOrOnly PoolId
All -> Maybe (Set PoolId)
forall a. Maybe a
Nothing
                Only [PoolId]
poolIds -> Set PoolId -> Maybe (Set PoolId)
forall a. a -> Maybe a
Just (Set PoolId -> Maybe (Set PoolId))
-> Set PoolId -> Maybe (Set PoolId)
forall a b. (a -> b) -> a -> b
$ [Item (Set PoolId)] -> Set PoolId
forall l. IsList l => [Item l] -> l
fromList [Item (Set PoolId)]
[PoolId]
poolIds

          let beo :: BabbageEraOnwards era
beo = Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era

          SerialisedStakeSnapshots era
result <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (SerialisedStakeSnapshots era)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (SerialisedStakeSnapshots era)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedStakeSnapshots era)))
forall era block point r.
BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedStakeSnapshots era)))
queryStakeSnapshot BabbageEraOnwards era
beo Maybe (Set PoolId)
poolFilter)

          (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era =>
    SerialisedStakeSnapshots era -> ExceptT QueryCmdError IO ())
-> SerialisedStakeSnapshots era
-> ExceptT QueryCmdError IO ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era (Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> SerialisedStakeSnapshots era
-> ExceptT QueryCmdError IO ()
forall era.
Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> SerialisedStakeSnapshots era
-> ExceptT QueryCmdError IO ()
writeStakeSnapshots Vary '[FormatJson, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile) SerialisedStakeSnapshots era
result
      )
      RIO e (Either QueryCmdError ())
-> (RIO e (Either QueryCmdError ()) -> RIO e ()) -> RIO e ()
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError ()) -> RIO e ()
CIO e (Either QueryCmdError ()) -> CIO e ()
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

runQueryLedgerStateCmd
  :: ()
  => Cmd.QueryLedgerStateCmdArgs
  -> CIO e ()
runQueryLedgerStateCmd :: forall e. QueryLedgerStateCmdArgs -> CIO e ()
runQueryLedgerStateCmd
  ( Cmd.QueryLedgerStateCmdArgs
      { commons :: QueryLedgerStateCmdArgs -> QueryCommons
Cmd.commons =
        Cmd.QueryCommons
          { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
          , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
          }
      , Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: QueryLedgerStateCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
Cmd.outputFormat
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryLedgerStateCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
      }
    ) = do
    ByteString
output <-
      IO (Either AcquiringFailure (Either QueryCmdError ByteString))
-> RIO e (Either QueryCmdError ByteString)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError ByteString)
-> IO (Either AcquiringFailure (Either QueryCmdError ByteString))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError ByteString)
 -> IO (Either AcquiringFailure (Either QueryCmdError ByteString)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError ByteString)
-> IO (Either AcquiringFailure (Either QueryCmdError ByteString))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ByteString
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError ByteString)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ByteString
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError ByteString))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ByteString
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError ByteString)
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra
            let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
            SerialisedDebugLedgerState era
serialisedDebugLedgerState <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (SerialisedDebugLedgerState era)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (SerialisedDebugLedgerState era)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedDebugLedgerState era)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedDebugLedgerState era)))
queryDebugLedgerState ShelleyBasedEra era
sbe)

            (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO ByteString
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ByteString
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO ByteString
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ByteString)
-> ExceptT QueryCmdError IO ByteString
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ByteString
forall a b. (a -> b) -> a -> b
$
              Era era
-> (EraCommonConstraints era =>
    ExceptT QueryCmdError IO ByteString)
-> ExceptT QueryCmdError IO ByteString
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => ExceptT QueryCmdError IO ByteString)
 -> ExceptT QueryCmdError IO ByteString)
-> (EraCommonConstraints era =>
    ExceptT QueryCmdError IO ByteString)
-> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
                Vary '[FormatJson, FormatText, FormatYaml]
outputFormat
                  Vary '[FormatJson, FormatText, FormatYaml]
-> (Vary '[FormatJson, FormatText, FormatYaml]
    -> ExceptT QueryCmdError IO ByteString)
-> ExceptT QueryCmdError IO ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatText, FormatYaml]
 -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ExceptT QueryCmdError IO ByteString
forall a. a -> a
id
                        ((Vary '[FormatJson, FormatText, FormatYaml]
  -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml]
 -> ExceptT QueryCmdError IO ByteString)
-> ((Vary '[] -> ExceptT QueryCmdError IO ByteString)
    -> Vary '[FormatJson, FormatText, FormatYaml]
    -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[] -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[FormatText, FormatYaml]
    -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ExceptT QueryCmdError IO ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ByteString
forall era.
IsShelleyBasedEra era =>
SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ByteString
ledgerStateAsJsonByteString SerialisedDebugLedgerState era
serialisedDebugLedgerState)
                        ((Vary '[FormatText, FormatYaml]
  -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml]
 -> ExceptT QueryCmdError IO ByteString)
-> ((Vary '[] -> ExceptT QueryCmdError IO ByteString)
    -> Vary '[FormatText, FormatYaml]
    -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[] -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[FormatYaml] -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatText, FormatYaml]
-> ExceptT QueryCmdError IO ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatText
FormatText -> SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ByteString
forall (f :: * -> *) era.
Applicative f =>
SerialisedDebugLedgerState era -> f ByteString
ledgerStateAsTextByteString SerialisedDebugLedgerState era
serialisedDebugLedgerState)
                        ((Vary '[FormatYaml] -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatText, FormatYaml]
 -> ExceptT QueryCmdError IO ByteString)
-> ((Vary '[] -> ExceptT QueryCmdError IO ByteString)
    -> Vary '[FormatYaml] -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[] -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatText, FormatYaml]
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[] -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatYaml]
-> ExceptT QueryCmdError IO ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ByteString
forall era.
IsShelleyBasedEra era =>
SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ByteString
ledgerStateAsYamlByteString SerialisedDebugLedgerState era
serialisedDebugLedgerState)
                        ((Vary '[] -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml]
 -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[] -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> ExceptT QueryCmdError IO ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
                    )
        )
        RIO e (Either QueryCmdError ByteString)
-> (RIO e (Either QueryCmdError ByteString) -> RIO e ByteString)
-> RIO e ByteString
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError ByteString) -> RIO e ByteString
CIO e (Either QueryCmdError ByteString) -> CIO e ByteString
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

ledgerStateAsJsonByteString
  :: IsShelleyBasedEra era
  => SerialisedDebugLedgerState era
  -> ExceptT QueryCmdError IO LBS.ByteString
ledgerStateAsJsonByteString :: forall era.
IsShelleyBasedEra era =>
SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ByteString
ledgerStateAsJsonByteString SerialisedDebugLedgerState era
serialisedDebugLedgerState =
  case SerialisedDebugLedgerState era
-> Either (ByteString, DecoderError) (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either (ByteString, DecoderError) (DebugLedgerState era)
decodeDebugLedgerState SerialisedDebugLedgerState era
serialisedDebugLedgerState of
    Left (ByteString
bs, DecoderError
_decoderError) ->
      IO (Either QueryCmdError ByteString)
-> ExceptT QueryCmdError IO ByteString
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either QueryCmdError ByteString)
 -> ExceptT QueryCmdError IO ByteString)
-> IO (Either QueryCmdError ByteString)
-> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
        ()
-> RIO () (Either QueryCmdError ByteString)
-> IO (Either QueryCmdError ByteString)
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO () (RIO () (Either QueryCmdError ByteString)
 -> IO (Either QueryCmdError ByteString))
-> RIO () (Either QueryCmdError ByteString)
-> IO (Either QueryCmdError ByteString)
forall a b. (a -> b) -> a -> b
$
          RIO () (Either QueryCmdError ByteString)
-> (SomeException -> RIO () (Either QueryCmdError ByteString))
-> RIO () (Either QueryCmdError ByteString)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
            (ByteString -> Either QueryCmdError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either QueryCmdError ByteString)
-> RIO () ByteString -> RIO () (Either QueryCmdError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CIO () ByteString
forall e. ByteString -> CIO e ByteString
cborToTextByteString ByteString
bs)
            (Either QueryCmdError ByteString
-> RIO () (Either QueryCmdError ByteString)
forall a. a -> RIO () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QueryCmdError ByteString
 -> RIO () (Either QueryCmdError ByteString))
-> (SomeException -> Either QueryCmdError ByteString)
-> SomeException
-> RIO () (Either QueryCmdError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryCmdError -> Either QueryCmdError ByteString
forall a b. a -> Either a b
Left (QueryCmdError -> Either QueryCmdError ByteString)
-> (SomeException -> QueryCmdError)
-> SomeException
-> Either QueryCmdError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SomeException -> QueryCmdError
QueryBackwardCompatibleError Text
"query ledger-state")
    Right DebugLedgerState era
decodededgerState -> ByteString -> ExceptT QueryCmdError IO ByteString
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ExceptT QueryCmdError IO ByteString)
-> ByteString -> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ DebugLedgerState era -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson DebugLedgerState era
decodededgerState ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"

ledgerStateAsTextByteString
  :: Applicative f
  => SerialisedDebugLedgerState era -> f LBS.ByteString
ledgerStateAsTextByteString :: forall (f :: * -> *) era.
Applicative f =>
SerialisedDebugLedgerState era -> f ByteString
ledgerStateAsTextByteString SerialisedDebugLedgerState era
serialisedDebugLedgerState =
  let SerialisedDebugLedgerState Serialised (NewEpochState (ShelleyLedgerEra era))
serLedgerState = SerialisedDebugLedgerState era
serialisedDebugLedgerState
   in ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> f ByteString) -> ByteString -> f ByteString
forall a b. (a -> b) -> a -> b
$ Serialised (NewEpochState (ShelleyLedgerEra era)) -> ByteString
forall {k} (a :: k). Serialised a -> ByteString
unSerialised Serialised (NewEpochState (ShelleyLedgerEra era))
serLedgerState

ledgerStateAsYamlByteString
  :: IsShelleyBasedEra era
  => SerialisedDebugLedgerState era
  -> ExceptT QueryCmdError IO LBS.ByteString
ledgerStateAsYamlByteString :: forall era.
IsShelleyBasedEra era =>
SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ByteString
ledgerStateAsYamlByteString SerialisedDebugLedgerState era
serialisedDebugLedgerState =
  case SerialisedDebugLedgerState era
-> Either (ByteString, DecoderError) (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either (ByteString, DecoderError) (DebugLedgerState era)
decodeDebugLedgerState SerialisedDebugLedgerState era
serialisedDebugLedgerState of
    Left (ByteString
bs, DecoderError
_decoderError) ->
      IO (Either QueryCmdError ByteString)
-> ExceptT QueryCmdError IO ByteString
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either QueryCmdError ByteString)
 -> ExceptT QueryCmdError IO ByteString)
-> IO (Either QueryCmdError ByteString)
-> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
        ()
-> RIO () (Either QueryCmdError ByteString)
-> IO (Either QueryCmdError ByteString)
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO () (RIO () (Either QueryCmdError ByteString)
 -> IO (Either QueryCmdError ByteString))
-> RIO () (Either QueryCmdError ByteString)
-> IO (Either QueryCmdError ByteString)
forall a b. (a -> b) -> a -> b
$
          RIO () (Either QueryCmdError ByteString)
-> (SomeException -> RIO () (Either QueryCmdError ByteString))
-> RIO () (Either QueryCmdError ByteString)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
            (ByteString -> Either QueryCmdError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either QueryCmdError ByteString)
-> RIO () ByteString -> RIO () (Either QueryCmdError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CIO () ByteString
forall e. ByteString -> CIO e ByteString
cborToTextByteString ByteString
bs)
            (Either QueryCmdError ByteString
-> RIO () (Either QueryCmdError ByteString)
forall a. a -> RIO () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QueryCmdError ByteString
 -> RIO () (Either QueryCmdError ByteString))
-> (SomeException -> Either QueryCmdError ByteString)
-> SomeException
-> RIO () (Either QueryCmdError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryCmdError -> Either QueryCmdError ByteString
forall a b. a -> Either a b
Left (QueryCmdError -> Either QueryCmdError ByteString)
-> (SomeException -> QueryCmdError)
-> SomeException
-> Either QueryCmdError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SomeException -> QueryCmdError
QueryBackwardCompatibleError Text
"query ledger-state")
    Right DebugLedgerState era
decodededgerState -> ByteString -> ExceptT QueryCmdError IO ByteString
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ExceptT QueryCmdError IO ByteString)
-> ByteString -> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ DebugLedgerState era -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml DebugLedgerState era
decodededgerState

runQueryLedgerPeerSnapshot
  :: ()
  => Cmd.QueryLedgerPeerSnapshotCmdArgs
  -> CIO e ()
runQueryLedgerPeerSnapshot :: forall e. QueryLedgerPeerSnapshotCmdArgs -> CIO e ()
runQueryLedgerPeerSnapshot
  Cmd.QueryLedgerPeerSnapshotCmdArgs
    { commons :: QueryLedgerPeerSnapshotCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: QueryLedgerPeerSnapshotCmdArgs -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryLedgerPeerSnapshotCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    Either ByteString LedgerPeerSnapshot
result <-
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (Either ByteString LedgerPeerSnapshot)))
-> RIO
     e (Either QueryCmdError (Either ByteString LedgerPeerSnapshot))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         BlockInMode
         ChainPoint
         QueryInMode
         ()
         IO
         (Either QueryCmdError (Either ByteString LedgerPeerSnapshot)))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (Either ByteString LedgerPeerSnapshot)))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> (NodeToClientVersion
    -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExprWithVersion LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target ((NodeToClientVersion
  -> LocalStateQueryExpr
       BlockInMode
       ChainPoint
       QueryInMode
       ()
       IO
       (Either QueryCmdError (Either ByteString LedgerPeerSnapshot)))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (Either ByteString LedgerPeerSnapshot))))
-> (NodeToClientVersion
    -> LocalStateQueryExpr
         BlockInMode
         ChainPoint
         QueryInMode
         ()
         IO
         (Either QueryCmdError (Either ByteString LedgerPeerSnapshot)))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (Either ByteString LedgerPeerSnapshot)))
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
globalNtcVersion -> ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either ByteString LedgerPeerSnapshot)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (Either ByteString LedgerPeerSnapshot))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (Either ByteString LedgerPeerSnapshot)
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (Either ByteString LedgerPeerSnapshot)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either ByteString LedgerPeerSnapshot)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (Either ByteString LedgerPeerSnapshot))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
cEra <-
              LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError AnyCardanoEra)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError AnyCardanoEra)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      AnyCardanoEra)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)

            Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra
            let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era

            Serialised LedgerPeerSnapshot
result <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Serialised LedgerPeerSnapshot)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Serialised LedgerPeerSnapshot)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Serialised LedgerPeerSnapshot)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Serialised LedgerPeerSnapshot)))
queryLedgerPeerSnapshot ShelleyBasedEra era
sbe)

            ShelleyNodeToClientVersion
shelleyNtcVersion <- Either QueryCmdError ShelleyNodeToClientVersion
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ShelleyNodeToClientVersion
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither (Either QueryCmdError ShelleyNodeToClientVersion
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ShelleyNodeToClientVersion)
-> Either QueryCmdError ShelleyNodeToClientVersion
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ShelleyNodeToClientVersion
forall a b. (a -> b) -> a -> b
$ Era era
-> NodeToClientVersion
-> Either QueryCmdError ShelleyNodeToClientVersion
forall era.
Era era
-> NodeToClientVersion
-> Either QueryCmdError ShelleyNodeToClientVersion
getShelleyNodeToClientVersion Era era
era NodeToClientVersion
globalNtcVersion

            (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either ByteString LedgerPeerSnapshot)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either ByteString LedgerPeerSnapshot))
-> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either ByteString LedgerPeerSnapshot)
forall a b. (a -> b) -> a -> b
$
              Era era
-> (EraCommonConstraints era =>
    ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot))
-> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot))
 -> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot))
-> (EraCommonConstraints era =>
    ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot))
-> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
forall a b. (a -> b) -> a -> b
$
                case ShelleyNodeToClientVersion
-> Serialised LedgerPeerSnapshot
-> Either (ByteString, DecoderError) LedgerPeerSnapshot
decodeBigLedgerPeerSnapshot ShelleyNodeToClientVersion
shelleyNtcVersion Serialised LedgerPeerSnapshot
result of
                  Left (ByteString
bs, DecoderError
_decoderError) -> Either ByteString LedgerPeerSnapshot
-> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ByteString LedgerPeerSnapshot
 -> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot))
-> Either ByteString LedgerPeerSnapshot
-> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString LedgerPeerSnapshot
forall a b. a -> Either a b
Left ByteString
bs
                  Right LedgerPeerSnapshot
snapshot -> Either ByteString LedgerPeerSnapshot
-> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ByteString LedgerPeerSnapshot
 -> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot))
-> Either ByteString LedgerPeerSnapshot
-> ExceptT QueryCmdError IO (Either ByteString LedgerPeerSnapshot)
forall a b. (a -> b) -> a -> b
$ LedgerPeerSnapshot -> Either ByteString LedgerPeerSnapshot
forall a b. b -> Either a b
Right LedgerPeerSnapshot
snapshot
        )
        RIO e (Either QueryCmdError (Either ByteString LedgerPeerSnapshot))
-> (RIO
      e (Either QueryCmdError (Either ByteString LedgerPeerSnapshot))
    -> RIO e (Either ByteString LedgerPeerSnapshot))
-> RIO e (Either ByteString LedgerPeerSnapshot)
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError (Either ByteString LedgerPeerSnapshot))
-> RIO e (Either ByteString LedgerPeerSnapshot)
CIO e (Either QueryCmdError (Either ByteString LedgerPeerSnapshot))
-> CIO e (Either ByteString LedgerPeerSnapshot)
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

    case Either ByteString LedgerPeerSnapshot
result of
      Left (ByteString
bs :: LBS.ByteString) -> do
        ExceptT HelpersError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT HelpersError IO () -> RIO e ())
-> ExceptT HelpersError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
      Right (LedgerPeerSnapshot
snapshot :: LedgerPeerSnapshot) -> do
        let output :: ByteString
output =
              Vary '[FormatJson, FormatYaml]
outputFormat
                Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> LedgerPeerSnapshot -> ByteString)
-> LedgerPeerSnapshot
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> LedgerPeerSnapshot -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LedgerPeerSnapshot
-> ByteString
forall a. a -> a
id
                      ((Vary '[FormatJson, FormatYaml]
  -> LedgerPeerSnapshot -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> LedgerPeerSnapshot
 -> ByteString)
-> ((Vary '[] -> LedgerPeerSnapshot -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> LedgerPeerSnapshot
    -> ByteString)
-> (Vary '[] -> LedgerPeerSnapshot -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LedgerPeerSnapshot
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> LedgerPeerSnapshot -> ByteString)
-> (Vary '[FormatYaml] -> LedgerPeerSnapshot -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LedgerPeerSnapshot
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> LedgerPeerSnapshot -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                      ((Vary '[FormatYaml] -> LedgerPeerSnapshot -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> LedgerPeerSnapshot
 -> ByteString)
-> ((Vary '[] -> LedgerPeerSnapshot -> ByteString)
    -> Vary '[FormatYaml] -> LedgerPeerSnapshot -> ByteString)
-> (Vary '[] -> LedgerPeerSnapshot -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LedgerPeerSnapshot
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> LedgerPeerSnapshot -> ByteString)
-> (Vary '[] -> LedgerPeerSnapshot -> ByteString)
-> Vary '[FormatYaml]
-> LedgerPeerSnapshot
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> LedgerPeerSnapshot -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                      ((Vary '[] -> LedgerPeerSnapshot -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> LedgerPeerSnapshot
 -> ByteString)
-> (Vary '[] -> LedgerPeerSnapshot -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> LedgerPeerSnapshot
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> LedgerPeerSnapshot -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
                  )
                (LedgerPeerSnapshot -> ByteString)
-> LedgerPeerSnapshot -> ByteString
forall a b. (a -> b) -> a -> b
$ LedgerPeerSnapshot
snapshot

        forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
          Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryProtocolStateCmd
  :: ()
  => Cmd.QueryProtocolStateCmdArgs
  -> CIO e ()
runQueryProtocolStateCmd :: forall e. QueryProtocolStateCmdArgs -> CIO e ()
runQueryProtocolStateCmd
  ( Cmd.QueryProtocolStateCmdArgs
      { commons :: QueryProtocolStateCmdArgs -> QueryCommons
Cmd.commons =
        Cmd.QueryCommons
          { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
          , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
          }
      , Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
outputFormat :: Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
outputFormat :: QueryProtocolStateCmdArgs
-> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
Cmd.outputFormat
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryProtocolStateCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
      }
    ) = do
    () <-
      IO (Either AcquiringFailure (Either QueryCmdError ()))
-> RIO e (Either QueryCmdError ())
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
 -> IO (Either AcquiringFailure (Either QueryCmdError ())))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ()
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ()))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$ do
            anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
cEra) <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            Era era
era <-
              Maybe (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (Era era))
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoEra era -> Maybe (Era era)
forall (eon :: * -> *) era.
Eon eon =>
CardanoEra era -> Maybe (eon era)
forEraMaybeEon CardanoEra era
cEra)
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (Era era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (Era era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (Era era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (Era era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> QueryCmdError
QueryCmdEraNotSupported AnyCardanoEra
anyE)

            ProtocolState era
ps <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (ProtocolState era)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ProtocolState era)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ProtocolState era)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ProtocolState era)))
queryProtocolState (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era))

            ByteString
output <-
              (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO ByteString
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ByteString
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                (ExceptT QueryCmdError IO ByteString
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ByteString)
-> ExceptT QueryCmdError IO ByteString
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ByteString
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era =>
    ExceptT QueryCmdError IO ByteString)
-> ExceptT QueryCmdError IO ByteString
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era
                ((EraCommonConstraints era => ExceptT QueryCmdError IO ByteString)
 -> ExceptT QueryCmdError IO ByteString)
-> (EraCommonConstraints era =>
    ExceptT QueryCmdError IO ByteString)
-> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
outputFormat
                  Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
-> (Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
 -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall a. a -> a
id
                        ((Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
  -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
 -> ProtocolState era
 -> ExceptT QueryCmdError IO ByteString)
-> ((Vary '[]
     -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
    -> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
    -> ProtocolState era
    -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatCborBin
 -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[FormatCborHex, FormatJson, FormatYaml]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatCborBin
FormatCborBin -> ProtocolState era -> ExceptT QueryCmdError IO ByteString
forall era.
ProtocolState era -> ExceptT QueryCmdError IO ByteString
protocolStateToCborBinary)
                        ((Vary '[FormatCborHex, FormatJson, FormatYaml]
  -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
 -> ProtocolState era
 -> ExceptT QueryCmdError IO ByteString)
-> ((Vary '[]
     -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
    -> Vary '[FormatCborHex, FormatJson, FormatYaml]
    -> ProtocolState era
    -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatCborHex
 -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[FormatJson, FormatYaml]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatCborHex, FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatCborHex
FormatCborHex -> (ByteString -> ByteString)
-> ExceptT QueryCmdError IO ByteString
-> ExceptT QueryCmdError IO ByteString
forall a b.
(a -> b)
-> ExceptT QueryCmdError IO a -> ExceptT QueryCmdError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
Base16.encode (ExceptT QueryCmdError IO ByteString
 -> ExceptT QueryCmdError IO ByteString)
-> (ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolState era -> ExceptT QueryCmdError IO ByteString
forall era.
ProtocolState era -> ExceptT QueryCmdError IO ByteString
protocolStateToCborBinary)
                        ((Vary '[FormatJson, FormatYaml]
  -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatCborHex, FormatJson, FormatYaml]
 -> ProtocolState era
 -> ExceptT QueryCmdError IO ByteString)
-> ((Vary '[]
     -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> ProtocolState era
    -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatCborHex, FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson
 -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[FormatYaml]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> (ChainDepState (ConsensusProtocol era) -> ByteString)
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
-> ExceptT QueryCmdError IO ByteString
forall a b.
(a -> b)
-> ExceptT QueryCmdError IO a -> ExceptT QueryCmdError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson (Value -> ByteString)
-> (ChainDepState (ConsensusProtocol era) -> Value)
-> ChainDepState (ConsensusProtocol era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainDepState (ConsensusProtocol era) -> Value
forall a. ToJSON a => a -> Value
toJSON) (ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
 -> ExceptT QueryCmdError IO ByteString)
-> (ProtocolState era
    -> ExceptT
         QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Era era
-> ProtocolState era
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall era.
Era era
-> ProtocolState era
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
protocolStateToChainDepState Era era
era)
                        ((Vary '[FormatYaml]
  -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> ProtocolState era
 -> ExceptT QueryCmdError IO ByteString)
-> ((Vary '[]
     -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
    -> Vary '[FormatYaml]
    -> ProtocolState era
    -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml
 -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> (ChainDepState (ConsensusProtocol era) -> ByteString)
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
-> ExceptT QueryCmdError IO ByteString
forall a b.
(a -> b)
-> ExceptT QueryCmdError IO a -> ExceptT QueryCmdError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml (Value -> ByteString)
-> (ChainDepState (ConsensusProtocol era) -> Value)
-> ChainDepState (ConsensusProtocol era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainDepState (ConsensusProtocol era) -> Value
forall a. ToJSON a => a -> Value
toJSON) (ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
 -> ExceptT QueryCmdError IO ByteString)
-> (ProtocolState era
    -> ExceptT
         QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Era era
-> ProtocolState era
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall era.
Era era
-> ProtocolState era
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
protocolStateToChainDepState Era era
era)
                        ((Vary '[]
  -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
 -> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
 -> ProtocolState era
 -> ExceptT QueryCmdError IO ByteString)
-> (Vary '[]
    -> ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> Vary '[FormatCborBin, FormatCborHex, FormatJson, FormatYaml]
-> ProtocolState era
-> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[]
-> ProtocolState era -> ExceptT QueryCmdError IO ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
                    )
                (ProtocolState era -> ExceptT QueryCmdError IO ByteString)
-> ProtocolState era -> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ ProtocolState era
ps

            forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ())
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> IO (Either (FileError ()) ())
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$
              Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output
        )
        RIO e (Either QueryCmdError ())
-> (RIO e (Either QueryCmdError ()) -> RIO e ()) -> RIO e ()
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError ()) -> RIO e ()
CIO e (Either QueryCmdError ()) -> CIO e ()
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

    () -> RIO e ()
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
   where
    protocolStateToChainDepState
      :: Exp.Era era
      -> ProtocolState era
      -> ExceptT QueryCmdError IO (Consensus.ChainDepState (ConsensusProtocol era))
    protocolStateToChainDepState :: forall era.
Era era
-> ProtocolState era
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
protocolStateToChainDepState Era era
era ProtocolState era
ps =
      Era era
-> (EraCommonConstraints era =>
    ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
 -> ExceptT
      QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> (EraCommonConstraints era =>
    ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall a b. (a -> b) -> a -> b
$ do
        Either
  (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era))
-> ExceptT
     QueryCmdError
     IO
     (Either
        (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)))
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProtocolState era
-> Either
     (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era))
forall era.
FromCBOR (ChainDepState (ConsensusProtocol era)) =>
ProtocolState era
-> Either
     (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era))
decodeProtocolState ProtocolState era
ps)
          ExceptT
  QueryCmdError
  IO
  (Either
     (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)))
    -> ExceptT
         QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall a b. a -> (a -> b) -> b
& ((ByteString, DecoderError)
 -> ExceptT
      QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ExceptT
     QueryCmdError
     IO
     (Either
        (ByteString, DecoderError) (ChainDepState (ConsensusProtocol era)))
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError IO (ChainDepState (ConsensusProtocol era)))
-> ((ByteString, DecoderError) -> QueryCmdError)
-> (ByteString, DecoderError)
-> ExceptT QueryCmdError IO (ChainDepState (ConsensusProtocol era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, DecoderError) -> QueryCmdError
QueryCmdProtocolStateDecodeFailure)

    protocolStateToCborBinary
      :: ProtocolState era
      -> ExceptT QueryCmdError IO LBS.ByteString
    protocolStateToCborBinary :: forall era.
ProtocolState era -> ExceptT QueryCmdError IO ByteString
protocolStateToCborBinary (ProtocolState Serialised (ChainDepState (ConsensusProtocol era))
pstate) =
      ByteString -> ExceptT QueryCmdError IO ByteString
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ExceptT QueryCmdError IO ByteString)
-> ByteString -> ExceptT QueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ Serialised (ChainDepState (ConsensusProtocol era)) -> ByteString
forall {k} (a :: k). Serialised a -> ByteString
unSerialised Serialised (ChainDepState (ConsensusProtocol era))
pstate

-- | Query the current delegations and reward accounts, filtered by a given
-- set of addresses, from a Shelley node via the local state query protocol.
runQueryStakeAddressInfoCmd
  :: ()
  => Cmd.QueryStakeAddressInfoCmdArgs
  -> CIO e ()
runQueryStakeAddressInfoCmd :: forall e. QueryStakeAddressInfoCmdArgs -> CIO e ()
runQueryStakeAddressInfoCmd
  Cmd.QueryStakeAddressInfoCmdArgs
    { commons :: QueryStakeAddressInfoCmdArgs -> QueryCommons
Cmd.commons =
      QueryCommons
commons
    , StakeAddress
addr :: StakeAddress
addr :: QueryStakeAddressInfoCmdArgs -> StakeAddress
Cmd.addr
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: QueryStakeAddressInfoCmdArgs -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryStakeAddressInfoCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    StakeAddressInfoData
said <- ExceptT QueryCmdError IO StakeAddressInfoData
-> RIO e StakeAddressInfoData
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO StakeAddressInfoData
 -> RIO e StakeAddressInfoData)
-> ExceptT QueryCmdError IO StakeAddressInfoData
-> RIO e StakeAddressInfoData
forall a b. (a -> b) -> a -> b
$ QueryCommons
-> StakeAddress -> ExceptT QueryCmdError IO StakeAddressInfoData
getQueryStakeAddressInfo QueryCommons
commons StakeAddress
addr

    ExceptT QueryCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO () -> RIO e ())
-> ExceptT QueryCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ StakeAddressInfoData
-> Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> ExceptT QueryCmdError IO ()
writeStakeAddressInfo StakeAddressInfoData
said Vary '[FormatJson, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile

-- | Container for data returned by 'getQueryStakeAddressInfo' where:
data StakeAddressInfoData = StakeAddressInfoData
  { StakeAddressInfoData -> DelegationsAndRewards
rewards :: DelegationsAndRewards
  -- ^ Rewards: map of stake addresses to pool ID and rewards balance.
  , StakeAddressInfoData -> Map StakeAddress Lovelace
deposits :: Map StakeAddress Lovelace
  -- ^ Deposits: the stake address registration deposit.
  , StakeAddressInfoData -> Map GovActionId Lovelace
gaDeposits :: Map L.GovActionId Lovelace
  -- ^ Gov Action Deposits: map of governance actions and their deposits associated
  --   with the reward account. Empty if not used in governance actions.
  , StakeAddressInfoData -> Map StakeAddress DRep
delegatees :: Map StakeAddress L.DRep
  -- ^ Delegatees: map of stake addresses and their vote delegation preference.
  }

getQueryStakeAddressInfo
  :: Cmd.QueryCommons
  -> StakeAddress
  -> ExceptT QueryCmdError IO StakeAddressInfoData
getQueryStakeAddressInfo :: QueryCommons
-> StakeAddress -> ExceptT QueryCmdError IO StakeAddressInfoData
getQueryStakeAddressInfo
  Cmd.QueryCommons
    { nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
Cmd.nodeConnInfo = nodeConnInfo :: LocalNodeConnectInfo
nodeConnInfo@LocalNodeConnectInfo{localNodeNetworkId :: LocalNodeConnectInfo -> NetworkId
localNodeNetworkId = NetworkId
networkId}
    , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
    }
  (StakeAddress Network
_ StakeCredential
addr) =
    do
      IO
  (Either
     AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO
   (Either
      AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
 -> ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure (Either QueryCmdError StakeAddressInfoData)))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError StakeAddressInfoData)
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError StakeAddressInfoData)
 -> IO
      (Either
         AcquiringFailure (Either QueryCmdError StakeAddressInfoData)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError StakeAddressInfoData)
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  StakeAddressInfoData
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError StakeAddressInfoData)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   StakeAddressInfoData
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     StakeAddressInfoData
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError StakeAddressInfoData)
forall a b. (a -> b) -> a -> b
$ do
        AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

        Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra

        let stakeAddr :: Set StakeCredential
stakeAddr = StakeCredential -> Set StakeCredential
forall a. a -> Set a
Set.singleton (StakeCredential -> Set StakeCredential)
-> StakeCredential -> Set StakeCredential
forall a b. (a -> b) -> a -> b
$ StakeCredential -> StakeCredential
fromShelleyStakeCredential StakeCredential
addr
            sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
            beo :: BabbageEraOnwards era
beo = Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era

        (Map StakeAddress Lovelace
stakeRewardAccountBalances, Map StakeAddress PoolId
stakePools) <-
          LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either
        EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Map StakeAddress Lovelace, Map StakeAddress PoolId)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> Set StakeCredential
-> NetworkId
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
forall era block point r.
ShelleyBasedEra era
-> Set StakeCredential
-> NetworkId
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId)))
queryStakeAddresses ShelleyBasedEra era
sbe Set StakeCredential
stakeAddr NetworkId
networkId)

        Map StakeCredential Lovelace
stakeDelegDeposits <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Map StakeCredential Lovelace)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Map StakeCredential Lovelace)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (BabbageEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Lovelace)))
forall era block point r.
BabbageEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential Lovelace)))
queryStakeDelegDeposits BabbageEraOnwards era
beo Set StakeCredential
stakeAddr)

        (Map StakeCredential DRep
stakeVoteDelegatees, Map GovActionId Lovelace
gaDeposits) <-
          CardanoEra era
-> (ConwayEraOnwards era
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (Map StakeCredential DRep, Map GovActionId Lovelace))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Map StakeCredential DRep, Map GovActionId Lovelace)
forall (eon :: * -> *) (f :: * -> *) a era.
(Eon eon, Applicative f, Monoid a) =>
CardanoEra era -> (eon era -> f a) -> f a
monoidForEraInEonA
            (BabbageEraOnwards era -> CardanoEra era
forall era. BabbageEraOnwards era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra BabbageEraOnwards era
beo)
            ( \ConwayEraOnwards era
ceo -> do
                Map StakeCredential DRep
stakeVoteDelegatees <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Map StakeCredential DRep)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Map StakeCredential DRep)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ConwayEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
forall era block point r.
ConwayEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
queryStakeVoteDelegatees ConwayEraOnwards era
ceo Set StakeCredential
stakeAddr)

                Seq (GovActionState (ShelleyLedgerEra era))
govActionStates :: (Seq.Seq (L.GovActionState (ShelleyLedgerEra era))) <-
                  LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Seq (GovActionState (ShelleyLedgerEra era)))
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Seq (GovActionState (ShelleyLedgerEra era))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Seq (GovActionState (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set GovActionId
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
forall era block point r.
ConwayEraOnwards era
-> Set GovActionId
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
queryProposals ConwayEraOnwards era
ceo Set GovActionId
forall a. Set a
Set.empty

                let gaDeposits :: Map GovActionId Lovelace
gaDeposits =
                      ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Map GovActionId Lovelace)
-> Map GovActionId Lovelace
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
ceo ((ConwayEraOnwardsConstraints era => Map GovActionId Lovelace)
 -> Map GovActionId Lovelace)
-> (ConwayEraOnwardsConstraints era => Map GovActionId Lovelace)
-> Map GovActionId Lovelace
forall a b. (a -> b) -> a -> b
$
                        [(GovActionId, Lovelace)] -> Map GovActionId Lovelace
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                          [ (GovActionState (ShelleyLedgerEra era) -> GovActionId
forall era. GovActionState era -> GovActionId
L.gasId GovActionState (ShelleyLedgerEra era)
gas, ProposalProcedure (ShelleyLedgerEra era) -> Lovelace
forall era. ProposalProcedure era -> Lovelace
L.pProcDeposit ProposalProcedure (ShelleyLedgerEra era)
proc)
                          | GovActionState (ShelleyLedgerEra era)
gas <- Seq (GovActionState (ShelleyLedgerEra era))
-> [Item (Seq (GovActionState (ShelleyLedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList Seq (GovActionState (ShelleyLedgerEra era))
govActionStates
                          , let proc :: ProposalProcedure (ShelleyLedgerEra era)
proc = GovActionState (ShelleyLedgerEra era)
-> ProposalProcedure (ShelleyLedgerEra era)
forall era. GovActionState era -> ProposalProcedure era
L.gasProposalProcedure GovActionState (ShelleyLedgerEra era)
gas
                          , let rewardAccount :: RewardAccount
rewardAccount = ProposalProcedure (ShelleyLedgerEra era) -> RewardAccount
forall era. ProposalProcedure era -> RewardAccount
L.pProcReturnAddr ProposalProcedure (ShelleyLedgerEra era)
proc
                                StakeCredential
stakeCredential :: Api.StakeCredential = StakeCredential -> StakeCredential
fromShelleyStakeCredential (StakeCredential -> StakeCredential)
-> StakeCredential -> StakeCredential
forall a b. (a -> b) -> a -> b
$ RewardAccount -> StakeCredential
L.raCredential RewardAccount
rewardAccount
                          , StakeCredential
stakeCredential StakeCredential -> StakeCredential -> Bool
forall a. Eq a => a -> a -> Bool
== StakeCredential -> StakeCredential
fromShelleyStakeCredential StakeCredential
addr
                          ]

                (Map StakeCredential DRep, Map GovActionId Lovelace)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Map StakeCredential DRep, Map GovActionId Lovelace)
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map StakeCredential DRep
stakeVoteDelegatees, Map GovActionId Lovelace
gaDeposits)
            )

        StakeAddressInfoData
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     StakeAddressInfoData
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeAddressInfoData
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      StakeAddressInfoData)
-> StakeAddressInfoData
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     StakeAddressInfoData
forall a b. (a -> b) -> a -> b
$
          DelegationsAndRewards
-> Map StakeAddress Lovelace
-> Map GovActionId Lovelace
-> Map StakeAddress DRep
-> StakeAddressInfoData
StakeAddressInfoData
            ((Map StakeAddress Lovelace, Map StakeAddress PoolId)
-> DelegationsAndRewards
DelegationsAndRewards (Map StakeAddress Lovelace
stakeRewardAccountBalances, Map StakeAddress PoolId
stakePools))
            ((StakeCredential -> StakeAddress)
-> Map StakeCredential Lovelace -> Map StakeAddress Lovelace
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
networkId) Map StakeCredential Lovelace
stakeDelegDeposits)
            Map GovActionId Lovelace
gaDeposits
            ((StakeCredential -> StakeAddress)
-> Map StakeCredential DRep -> Map StakeAddress DRep
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
networkId) Map StakeCredential DRep
stakeVoteDelegatees)
      ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
    -> ExceptT
         QueryCmdError IO (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError IO (Either QueryCmdError StakeAddressInfoData)
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError IO (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError IO (Either QueryCmdError StakeAddressInfoData)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError IO (Either QueryCmdError StakeAddressInfoData)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError IO (Either QueryCmdError StakeAddressInfoData))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError IO (Either QueryCmdError StakeAddressInfoData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
      ExceptT
  QueryCmdError IO (Either QueryCmdError StakeAddressInfoData)
-> (ExceptT
      QueryCmdError IO (Either QueryCmdError StakeAddressInfoData)
    -> ExceptT QueryCmdError IO StakeAddressInfoData)
-> ExceptT QueryCmdError IO StakeAddressInfoData
forall a b. a -> (a -> b) -> b
& (QueryCmdError -> ExceptT QueryCmdError IO StakeAddressInfoData)
-> ExceptT
     QueryCmdError IO (Either QueryCmdError StakeAddressInfoData)
-> ExceptT QueryCmdError IO StakeAddressInfoData
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError -> ExceptT QueryCmdError IO StakeAddressInfoData
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

-- -------------------------------------------------------------------------------------------------

getShelleyNodeToClientVersion
  :: Exp.Era era -> NodeToClientVersion -> Either QueryCmdError ShelleyNodeToClientVersion
getShelleyNodeToClientVersion :: forall era.
Era era
-> NodeToClientVersion
-> Either QueryCmdError ShelleyNodeToClientVersion
getShelleyNodeToClientVersion Era era
era NodeToClientVersion
globalNtcVersion =
  case Proxy (CardanoBlock StandardCrypto)
-> Map
     NodeToClientVersion
     (BlockNodeToClientVersion (CardanoBlock StandardCrypto))
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(CardanoBlock StandardCrypto)) Map
  NodeToClientVersion
  (HardForkNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto))
-> NodeToClientVersion
-> HardForkNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall k a. Ord k => Map k a -> k -> a
Map.! NodeToClientVersion
globalNtcVersion of
    HardForkNodeToClientEnabled HardForkSpecificNodeToClientVersion
_ NP
  EraNodeToClientVersion
  (ByronBlock : CardanoShelleyEras StandardCrypto)
np ->
      case Era era
era of
        Era era
Exp.ConwayEra ->
          case Index
  (ByronBlock : CardanoShelleyEras StandardCrypto)
  (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> NP
     EraNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto)
-> EraNodeToClientVersion
     (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall {k} (xs :: [k]) (x :: k) (f :: k -> *).
All Top xs =>
Index xs x -> NP f xs -> f x
projectNP Index
  (ByronBlock : CardanoShelleyEras StandardCrypto)
  (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall x'1 x'2 x'3 x'4 x'5 x'6 x (xs1 :: [*]).
Index (x'1 : x'2 : x'3 : x'4 : x'5 : x'6 : x : xs1) x
conwayIndex NP
  EraNodeToClientVersion
  (ByronBlock : CardanoShelleyEras StandardCrypto)
np of
            EraNodeToClientVersion
  (ShelleyBlock (Praos StandardCrypto) ConwayEra)
EraNodeToClientDisabled -> QueryCmdError -> Either QueryCmdError ShelleyNodeToClientVersion
forall a b. a -> Either a b
Left QueryCmdError
QueryCmdNodeToClientDisabled
            EraNodeToClientEnabled BlockNodeToClientVersion
  (ShelleyBlock (Praos StandardCrypto) ConwayEra)
shelleyNtcVersion -> ShelleyNodeToClientVersion
-> Either QueryCmdError ShelleyNodeToClientVersion
forall a. a -> Either QueryCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockNodeToClientVersion
  (ShelleyBlock (Praos StandardCrypto) ConwayEra)
ShelleyNodeToClientVersion
shelleyNtcVersion
        Era era
Exp.DijkstraEra ->
          case Index
  (ByronBlock : CardanoShelleyEras StandardCrypto)
  (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
-> NP
     EraNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto)
-> EraNodeToClientVersion
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (f :: k -> *).
All Top xs =>
Index xs x -> NP f xs -> f x
projectNP Index
  (ByronBlock : CardanoShelleyEras StandardCrypto)
  (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
forall x'1 x'2 x'3 x'4 x'5 x'6 x'7 x (xs1 :: [*]).
Index (x'1 : x'2 : x'3 : x'4 : x'5 : x'6 : x'7 : x : xs1) x
dijkstraIndex NP
  EraNodeToClientVersion
  (ByronBlock : CardanoShelleyEras StandardCrypto)
np of
            EraNodeToClientVersion
  (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
EraNodeToClientDisabled -> QueryCmdError -> Either QueryCmdError ShelleyNodeToClientVersion
forall a b. a -> Either a b
Left QueryCmdError
QueryCmdNodeToClientDisabled
            EraNodeToClientEnabled BlockNodeToClientVersion
  (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
shelleyNtcVersion -> ShelleyNodeToClientVersion
-> Either QueryCmdError ShelleyNodeToClientVersion
forall a. a -> Either QueryCmdError a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockNodeToClientVersion
  (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
ShelleyNodeToClientVersion
shelleyNtcVersion
    HardForkNodeToClientDisabled BlockNodeToClientVersion x
_ -> QueryCmdError -> Either QueryCmdError ShelleyNodeToClientVersion
forall a b. a -> Either a b
Left QueryCmdError
QueryCmdNodeToClientDisabled

conwayIndex :: Index (x'1 : x'2 : x'3 : x'4 : x'5 : x'6 : x : xs1) x
conwayIndex :: forall x'1 x'2 x'3 x'4 x'5 x'6 x (xs1 :: [*]).
Index (x'1 : x'2 : x'3 : x'4 : x'5 : x'6 : x : xs1) x
conwayIndex = Index (x'2 : x'3 : x'4 : x'5 : x'6 : x : xs1) x
-> Index (x'1 : x'2 : x'3 : x'4 : x'5 : x'6 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'3 : x'4 : x'5 : x'6 : x : xs1) x
-> Index (x'2 : x'3 : x'4 : x'5 : x'6 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'4 : x'5 : x'6 : x : xs1) x
-> Index (x'3 : x'4 : x'5 : x'6 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'5 : x'6 : x : xs1) x
-> Index (x'4 : x'5 : x'6 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'6 : x : xs1) x -> Index (x'5 : x'6 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x : xs1) x -> Index (x'6 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index (x : xs1) x
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ)))))

dijkstraIndex :: Index (x'1 : x'2 : x'3 : x'4 : x'5 : x'6 : x'7 : x : xs1) x
dijkstraIndex :: forall x'1 x'2 x'3 x'4 x'5 x'6 x'7 x (xs1 :: [*]).
Index (x'1 : x'2 : x'3 : x'4 : x'5 : x'6 : x'7 : x : xs1) x
dijkstraIndex = Index (x'2 : x'3 : x'4 : x'5 : x'6 : x'7 : x : xs1) x
-> Index (x'1 : x'2 : x'3 : x'4 : x'5 : x'6 : x'7 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'3 : x'4 : x'5 : x'6 : x'7 : x : xs1) x
-> Index (x'2 : x'3 : x'4 : x'5 : x'6 : x'7 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'4 : x'5 : x'6 : x'7 : x : xs1) x
-> Index (x'3 : x'4 : x'5 : x'6 : x'7 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'5 : x'6 : x'7 : x : xs1) x
-> Index (x'4 : x'5 : x'6 : x'7 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'6 : x'7 : x : xs1) x
-> Index (x'5 : x'6 : x'7 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x'7 : x : xs1) x -> Index (x'6 : x'7 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index (x : xs1) x -> Index (x'7 : x : xs1) x
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index (x : xs1) x
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ))))))

writeStakeAddressInfo
  :: StakeAddressInfoData
  -> Vary [FormatJson, FormatYaml]
  -> Maybe (File () Out)
  -> ExceptT QueryCmdError IO ()
writeStakeAddressInfo :: StakeAddressInfoData
-> Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> ExceptT QueryCmdError IO ()
writeStakeAddressInfo
  ( StakeAddressInfoData
      { rewards :: StakeAddressInfoData -> DelegationsAndRewards
rewards = DelegationsAndRewards (Map StakeAddress Lovelace
stakeAccountBalances, Map StakeAddress PoolId
stakePools)
      , deposits :: StakeAddressInfoData -> Map StakeAddress Lovelace
deposits = Map StakeAddress Lovelace
stakeDelegDeposits
      , gaDeposits :: StakeAddressInfoData -> Map GovActionId Lovelace
gaDeposits = Map GovActionId Lovelace
gaDeposits
      , delegatees :: StakeAddressInfoData -> Map StakeAddress DRep
delegatees = Map StakeAddress DRep
voteDelegatees
      }
    )
  Vary '[FormatJson, FormatYaml]
outputFormat
  Maybe (File () 'Out)
mOutFile = do
    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml] -> [Value] -> ByteString)
-> [Value]
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml] -> [Value] -> ByteString)
-> Vary '[FormatJson, FormatYaml] -> [Value] -> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml] -> [Value] -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> [Value] -> ByteString)
-> ((Vary '[] -> [Value] -> ByteString)
    -> Vary '[FormatJson, FormatYaml] -> [Value] -> ByteString)
-> (Vary '[] -> [Value] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [Value]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> [Value] -> ByteString)
-> (Vary '[FormatYaml] -> [Value] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [Value]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml] -> [Value] -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> [Value] -> ByteString)
-> ((Vary '[] -> [Value] -> ByteString)
    -> Vary '[FormatYaml] -> [Value] -> ByteString)
-> (Vary '[] -> [Value] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [Value]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> [Value] -> ByteString)
-> (Vary '[] -> [Value] -> ByteString)
-> Vary '[FormatYaml]
-> [Value]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> [Value] -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> [Value] -> ByteString)
-> (Vary '[] -> [Value] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [Value]
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> [Value] -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Value]
jsonInfo

    (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output
   where
    jsonInfo :: [Aeson.Value]
    jsonInfo :: [Value]
jsonInfo =
      ((StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe DRep,
  Maybe Lovelace)
 -> Value)
-> [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe DRep,
     Maybe Lovelace)]
-> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
        ( \(StakeAddress
addr, Maybe Lovelace
mBalance, Maybe PoolId
mPoolId, Maybe DRep
mDRep, Maybe Lovelace
mDeposit) ->
            [Pair] -> Value
Aeson.object
              [ Key
"address" Key -> StakeAddress -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StakeAddress
addr
              , Key
"stakeDelegation" Key -> Maybe Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (PoolId -> Value) -> Maybe PoolId -> Maybe Value
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PoolId -> Value
friendlyStake Maybe PoolId
mPoolId
              , Key
"voteDelegation" Key -> Maybe Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (DRep -> Value) -> Maybe DRep -> Maybe Value
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DRep -> Value
friendlyDRep Maybe DRep
mDRep
              , Key
"rewardAccountBalance" Key -> Maybe Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
mBalance
              , Key
"stakeRegistrationDeposit" Key -> Maybe Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
mDeposit
              , Key
"govActionDeposits" Key -> Map GovActionId Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map GovActionId Lovelace
gaDeposits
              ]
        )
        [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe DRep,
  Maybe Lovelace)]
merged

    friendlyStake :: PoolId -> Aeson.Value
    friendlyStake :: PoolId -> Value
friendlyStake PoolId
poolId =
      [Pair] -> Value
Aeson.object
        [ Key
"stakePoolBech32" Key -> UsingBech32 PoolId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolId -> UsingBech32 PoolId
forall a. a -> UsingBech32 a
UsingBech32 PoolId
poolId
        , Key
"stakePoolHex" Key -> UsingRawBytesHex PoolId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PoolId -> UsingRawBytesHex PoolId
forall a. a -> UsingRawBytesHex a
UsingRawBytesHex PoolId
poolId
        ]

    merged
      :: [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe L.DRep, Maybe Lovelace)]
    merged :: [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe DRep,
  Maybe Lovelace)]
merged =
      [ (StakeAddress
addr, Maybe Lovelace
mBalance, Maybe PoolId
mPoolId, Maybe DRep
mDRep, Maybe Lovelace
mDeposit)
      | StakeAddress
addr <-
          Set StakeAddress -> [Item (Set StakeAddress)]
forall l. IsList l => l -> [Item l]
toList
            ( [Set StakeAddress] -> Set StakeAddress
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                [ Map StakeAddress Lovelace -> Set StakeAddress
forall k a. Map k a -> Set k
Map.keysSet Map StakeAddress Lovelace
stakeAccountBalances
                , Map StakeAddress PoolId -> Set StakeAddress
forall k a. Map k a -> Set k
Map.keysSet Map StakeAddress PoolId
stakePools
                , Map StakeAddress Lovelace -> Set StakeAddress
forall k a. Map k a -> Set k
Map.keysSet Map StakeAddress Lovelace
stakeDelegDeposits
                , Map StakeAddress DRep -> Set StakeAddress
forall k a. Map k a -> Set k
Map.keysSet Map StakeAddress DRep
voteDelegatees
                ]
            )
      , let mBalance :: Maybe Lovelace
mBalance = StakeAddress -> Map StakeAddress Lovelace -> Maybe Lovelace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
addr Map StakeAddress Lovelace
stakeAccountBalances
            mPoolId :: Maybe PoolId
mPoolId = StakeAddress -> Map StakeAddress PoolId -> Maybe PoolId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
addr Map StakeAddress PoolId
stakePools
            mDeposit :: Maybe Lovelace
mDeposit = StakeAddress -> Map StakeAddress Lovelace -> Maybe Lovelace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
addr Map StakeAddress Lovelace
stakeDelegDeposits
            mDRep :: Maybe DRep
mDRep = StakeAddress -> Map StakeAddress DRep -> Maybe DRep
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
addr Map StakeAddress DRep
voteDelegatees
      ]

writeStakeSnapshots
  :: forall era
   . Vary [FormatJson, FormatYaml]
  -> Maybe (File () Out)
  -> SerialisedStakeSnapshots era
  -> ExceptT QueryCmdError IO ()
writeStakeSnapshots :: forall era.
Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> SerialisedStakeSnapshots era
-> ExceptT QueryCmdError IO ()
writeStakeSnapshots Vary '[FormatJson, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile SerialisedStakeSnapshots era
qState = do
  StakeSnapshot StakeSnapshots
snapshot <-
    Either DecoderError (StakeSnapshot era)
-> ExceptT
     QueryCmdError IO (Either DecoderError (StakeSnapshot era))
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SerialisedStakeSnapshots era
-> Either DecoderError (StakeSnapshot era)
forall era.
SerialisedStakeSnapshots era
-> Either DecoderError (StakeSnapshot era)
decodeStakeSnapshot SerialisedStakeSnapshots era
qState)
      ExceptT QueryCmdError IO (Either DecoderError (StakeSnapshot era))
-> (ExceptT
      QueryCmdError IO (Either DecoderError (StakeSnapshot era))
    -> ExceptT QueryCmdError IO (StakeSnapshot era))
-> ExceptT QueryCmdError IO (StakeSnapshot era)
forall a b. a -> (a -> b) -> b
& (DecoderError -> ExceptT QueryCmdError IO (StakeSnapshot era))
-> ExceptT
     QueryCmdError IO (Either DecoderError (StakeSnapshot era))
-> ExceptT QueryCmdError IO (StakeSnapshot era)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError IO (StakeSnapshot era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO (StakeSnapshot era))
-> (DecoderError -> QueryCmdError)
-> DecoderError
-> ExceptT QueryCmdError IO (StakeSnapshot era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> QueryCmdError
QueryCmdStakeSnapshotDecodeError)

  let output :: ByteString
output =
        Vary '[FormatJson, FormatYaml]
outputFormat
          Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml] -> StakeSnapshots -> ByteString)
-> StakeSnapshots
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml] -> StakeSnapshots -> ByteString)
-> Vary '[FormatJson, FormatYaml] -> StakeSnapshots -> ByteString
forall a. a -> a
id
                ((Vary '[FormatJson, FormatYaml] -> StakeSnapshots -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> StakeSnapshots -> ByteString)
-> ((Vary '[] -> StakeSnapshots -> ByteString)
    -> Vary '[FormatJson, FormatYaml] -> StakeSnapshots -> ByteString)
-> (Vary '[] -> StakeSnapshots -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> StakeSnapshots
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> StakeSnapshots -> ByteString)
-> (Vary '[FormatYaml] -> StakeSnapshots -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> StakeSnapshots
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> StakeSnapshots -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                ((Vary '[FormatYaml] -> StakeSnapshots -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> StakeSnapshots -> ByteString)
-> ((Vary '[] -> StakeSnapshots -> ByteString)
    -> Vary '[FormatYaml] -> StakeSnapshots -> ByteString)
-> (Vary '[] -> StakeSnapshots -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> StakeSnapshots
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> StakeSnapshots -> ByteString)
-> (Vary '[] -> StakeSnapshots -> ByteString)
-> Vary '[FormatYaml]
-> StakeSnapshots
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> StakeSnapshots -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                ((Vary '[] -> StakeSnapshots -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> StakeSnapshots -> ByteString)
-> (Vary '[] -> StakeSnapshots -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> StakeSnapshots
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> StakeSnapshots -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
            )
          (StakeSnapshots -> ByteString) -> StakeSnapshots -> ByteString
forall a b. (a -> b) -> a -> b
$ StakeSnapshots
snapshot

  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError
    (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

-- | This function obtains the pool parameters, equivalent to the following jq query on the output of query ledger-state
--   .nesEs.esLState.lsDPState.dpsPState.psStakePoolParams.<pool_id>
writePoolState
  :: Exp.Era era
  -> Vary [FormatJson, FormatYaml]
  -> Maybe (File () Out)
  -> SerialisedPoolState
  -> ExceptT QueryCmdError IO ()
writePoolState :: forall era.
Era era
-> Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> SerialisedPoolState
-> ExceptT QueryCmdError IO ()
writePoolState Era era
era Vary '[FormatJson, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile SerialisedPoolState
serialisedCurrentEpochState = do
  PoolState era
poolState <-
    Either QueryCmdError (PoolState era)
-> ExceptT QueryCmdError IO (PoolState era)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QueryCmdError (PoolState era)
 -> ExceptT QueryCmdError IO (PoolState era))
-> (Either DecoderError (PoolState era)
    -> Either QueryCmdError (PoolState era))
-> Either DecoderError (PoolState era)
-> ExceptT QueryCmdError IO (PoolState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DecoderError -> QueryCmdError)
-> Either DecoderError (PoolState era)
-> Either QueryCmdError (PoolState era)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> QueryCmdError
QueryCmdPoolStateDecodeError (Either DecoderError (PoolState era)
 -> ExceptT QueryCmdError IO (PoolState era))
-> Either DecoderError (PoolState era)
-> ExceptT QueryCmdError IO (PoolState era)
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra era
-> SerialisedPoolState -> Either DecoderError (PoolState era)
forall era.
ShelleyBasedEra era
-> SerialisedPoolState -> Either DecoderError (PoolState era)
decodePoolState (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) SerialisedPoolState
serialisedCurrentEpochState

  let poolStates :: Map (KeyHash 'StakePool) PoolParams
poolStates = PoolState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PoolState era -> Map (KeyHash 'StakePool) PoolParams
mkPoolStates PoolState era
poolState :: Map (L.KeyHash L.StakePool) PoolParams
      output :: ByteString
output =
        Vary '[FormatJson, FormatYaml]
outputFormat
          Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> Map (KeyHash 'StakePool) PoolParams
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map (KeyHash 'StakePool) PoolParams
-> ByteString
forall a. a -> a
id
                ((Vary '[FormatJson, FormatYaml]
  -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Map (KeyHash 'StakePool) PoolParams
 -> ByteString)
-> ((Vary '[] -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> Map (KeyHash 'StakePool) PoolParams
    -> ByteString)
-> (Vary '[] -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map (KeyHash 'StakePool) PoolParams
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> (Vary '[FormatYaml]
    -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map (KeyHash 'StakePool) PoolParams
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> Map (KeyHash 'StakePool) PoolParams -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                ((Vary '[FormatYaml]
  -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Map (KeyHash 'StakePool) PoolParams
 -> ByteString)
-> ((Vary '[] -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
    -> Vary '[FormatYaml]
    -> Map (KeyHash 'StakePool) PoolParams
    -> ByteString)
-> (Vary '[] -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map (KeyHash 'StakePool) PoolParams
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> (Vary '[] -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> Vary '[FormatYaml]
-> Map (KeyHash 'StakePool) PoolParams
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> Map (KeyHash 'StakePool) PoolParams -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                ((Vary '[] -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Map (KeyHash 'StakePool) PoolParams
 -> ByteString)
-> (Vary '[] -> Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map (KeyHash 'StakePool) PoolParams
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> Map (KeyHash 'StakePool) PoolParams -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
            )
          (Map (KeyHash 'StakePool) PoolParams -> ByteString)
-> Map (KeyHash 'StakePool) PoolParams -> ByteString
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'StakePool) PoolParams
poolStates

  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError
    (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

writeFilteredUTxOs
  :: ShelleyBasedEra era
  -> Vary [FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
  -> Maybe (File () Out)
  -> UTxO era
  -> ExceptT QueryCmdError IO ()
writeFilteredUTxOs :: forall era.
ShelleyBasedEra era
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> Maybe (File () 'Out)
-> UTxO era
-> ExceptT QueryCmdError IO ()
writeFilteredUTxOs ShelleyBasedEra era
era Vary
  '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
format Maybe (File () 'Out)
mOutFile UTxO era
utxo = do
  let output :: ByteString
output =
        ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
era ((ShelleyBasedEraConstraints era => ByteString) -> ByteString)
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$
          Vary
  '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
format
            Vary
  '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> (Vary
      '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
    -> ByteString)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary
   '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> ByteString)
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> ByteString
forall a. a -> a
id
                  ((Vary
    '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
  -> ByteString)
 -> Vary
      '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary
         '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
    -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatCborBin -> ByteString)
-> (Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
    -> ByteString)
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatCborBin
FormatCborBin -> UTxO (ShelleyLedgerEra era) -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize (UTxO (ShelleyLedgerEra era) -> ByteString)
-> UTxO (ShelleyLedgerEra era) -> ByteString
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
era UTxO era
utxo)
                  ((Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
  -> ByteString)
 -> Vary
      '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
    -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatCborHex -> ByteString)
-> (Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatCborHex
FormatCborHex -> ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (UTxO (ShelleyLedgerEra era) -> ByteString)
-> UTxO (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO (ShelleyLedgerEra era) -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize (UTxO (ShelleyLedgerEra era) -> ByteString)
-> UTxO (ShelleyLedgerEra era) -> ByteString
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
era UTxO era
utxo)
                  ((Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
 -> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> ByteString)
-> (Vary '[FormatText, FormatYaml] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> UTxO era -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson UTxO era
utxo)
                  ((Vary '[FormatText, FormatYaml] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> ByteString)
-> (Vary '[FormatYaml] -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatText
FormatText -> Text -> ByteString
strictTextToLazyBytestring (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ UTxO era -> Text
forall era. UTxO era -> Text
filteredUTxOsToText UTxO era
utxo)
                  ((Vary '[FormatYaml] -> ByteString)
 -> Vary '[FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString) -> Vary '[FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> ByteString)
-> (Vary '[] -> ByteString) -> Vary '[FormatYaml] -> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> UTxO era -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml UTxO era
utxo)
                  ((Vary '[] -> ByteString)
 -> Vary
      '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary
     '[FormatCborBin, FormatCborHex, FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )

  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError
    (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

filteredUTxOsToText :: UTxO era -> Text
filteredUTxOsToText :: forall era. UTxO era -> Text
filteredUTxOsToText (UTxO Map TxIn (TxOut CtxUTxO era)
utxo) = do
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ [Text] -> Text
Text.unlines [Text
title, Int -> Text -> Text
Text.replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Text
"-"]
    , [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        ((TxIn, TxOut CtxUTxO era) -> Text)
-> [(TxIn, TxOut CtxUTxO era)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, TxOut CtxUTxO era) -> Text
forall era. (TxIn, TxOut CtxUTxO era) -> Text
utxoToText ([(TxIn, TxOut CtxUTxO era)] -> [Text])
-> [(TxIn, TxOut CtxUTxO era)] -> [Text]
forall a b. (a -> b) -> a -> b
$
          Map TxIn (TxOut CtxUTxO era)
-> [Item (Map TxIn (TxOut CtxUTxO era))]
forall l. IsList l => l -> [Item l]
toList Map TxIn (TxOut CtxUTxO era)
utxo
    ]
 where
  title :: Text
  title :: Text
title =
    Text
"                           TxHash                                 TxIx        Amount"

utxoToText
  :: (TxIn, TxOut CtxUTxO era)
  -> Text
utxoToText :: forall era. (TxIn, TxOut CtxUTxO era) -> Text
utxoToText (TxIn, TxOut CtxUTxO era)
txInOutTuple =
  let (TxIn (TxId Hash HASH EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatum CtxUTxO era
mDatum ReferenceScript era
_) = (TxIn, TxOut CtxUTxO era)
txInOutTuple
   in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ ByteString -> Text
Text.decodeLatin1 (Hash HASH EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash HASH EraIndependentTxBody
txhash)
        , Int -> Word -> Text
forall a. Show a => Int -> a -> Text
textShowN Int
6 Word
index
        , Text
"        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxOutValue era -> Text
forall era. TxOutValue era -> Text
printableValue TxOutValue era
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" + " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (TxOutDatum CtxUTxO era -> FilePath
forall a. Show a => a -> FilePath
show TxOutDatum CtxUTxO era
mDatum)
        ]
 where
  textShowN :: Show a => Int -> a -> Text
  textShowN :: forall a. Show a => Int -> a -> Text
textShowN Int
len a
x =
    let str :: FilePath
str = a -> FilePath
forall a. Show a => a -> FilePath
show a
x
        slen :: Int
slen = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
str
     in FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
slen)) Char
' ' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
str

  printableValue :: TxOutValue era -> Text
  printableValue :: forall era. TxOutValue era -> Text
printableValue = \case
    TxOutValueByron (L.Coin Integer
i) -> FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i
    TxOutValueShelleyBased ShelleyBasedEra era
sbe2 Value (ShelleyLedgerEra era)
val -> Value -> Text
renderValue (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
forall era.
ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
Api.fromLedgerValue ShelleyBasedEra era
sbe2 Value (ShelleyLedgerEra era)
val

runQueryStakePoolsCmd
  :: ()
  => Cmd.QueryStakePoolsCmdArgs
  -> CIO e ()
runQueryStakePoolsCmd :: forall e. QueryStakePoolsCmdArgs -> CIO e ()
runQueryStakePoolsCmd
  Cmd.QueryStakePoolsCmdArgs
    { commons :: QueryStakePoolsCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: QueryStakePoolsCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryStakePoolsCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    IO (Either AcquiringFailure (Either QueryCmdError ()))
-> RIO e (Either QueryCmdError ())
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
      ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
 -> IO (Either AcquiringFailure (Either QueryCmdError ())))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT @QueryCmdError (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ()
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ()))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$ do
          AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra
          let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
          Set PoolId
poolIds <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Set PoolId)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch (Set PoolId)))
queryStakePools ShelleyBasedEra era
sbe)

          ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$ Vary '[FormatJson, FormatText, FormatYaml]
-> Maybe (File () 'Out)
-> Set PoolId
-> ExceptT QueryCmdError IO ()
writeStakePools Vary '[FormatJson, FormatText, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile Set PoolId
poolIds
      )
      RIO e (Either QueryCmdError ())
-> (RIO e (Either QueryCmdError ()) -> RIO e ()) -> RIO e ()
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError ()) -> RIO e ()
CIO e (Either QueryCmdError ()) -> CIO e ()
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

-- TODO: replace with writeFormattedOutput
writeStakePools
  :: Vary [FormatJson, FormatText, FormatYaml]
  -> Maybe (File () Out)
  -> Set PoolId
  -> ExceptT QueryCmdError IO ()
writeStakePools :: Vary '[FormatJson, FormatText, FormatYaml]
-> Maybe (File () 'Out)
-> Set PoolId
-> ExceptT QueryCmdError IO ()
writeStakePools Vary '[FormatJson, FormatText, FormatYaml]
format Maybe (File () 'Out)
mOutFile Set PoolId
stakePools = do
  let output :: ByteString
output =
        Vary '[FormatJson, FormatText, FormatYaml]
format
          Vary '[FormatJson, FormatText, FormatYaml]
-> (Vary '[FormatJson, FormatText, FormatYaml]
    -> Set PoolId -> ByteString)
-> Set PoolId
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatText, FormatYaml]
 -> Set PoolId -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> Set PoolId
-> ByteString
forall a. a -> a
id
                ((Vary '[FormatJson, FormatText, FormatYaml]
  -> Set PoolId -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml]
 -> Set PoolId
 -> ByteString)
-> ((Vary '[] -> Set PoolId -> ByteString)
    -> Vary '[FormatJson, FormatText, FormatYaml]
    -> Set PoolId
    -> ByteString)
-> (Vary '[] -> Set PoolId -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> Set PoolId
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> Set PoolId -> ByteString)
-> (Vary '[FormatText, FormatYaml] -> Set PoolId -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> Set PoolId
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> Set PoolId -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                ((Vary '[FormatText, FormatYaml] -> Set PoolId -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml]
 -> Set PoolId
 -> ByteString)
-> ((Vary '[] -> Set PoolId -> ByteString)
    -> Vary '[FormatText, FormatYaml] -> Set PoolId -> ByteString)
-> (Vary '[] -> Set PoolId -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> Set PoolId
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> Set PoolId -> ByteString)
-> (Vary '[FormatYaml] -> Set PoolId -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> Set PoolId
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatText
FormatText -> Set PoolId -> ByteString
encodeText)
                ((Vary '[FormatYaml] -> Set PoolId -> ByteString)
 -> Vary '[FormatText, FormatYaml] -> Set PoolId -> ByteString)
-> ((Vary '[] -> Set PoolId -> ByteString)
    -> Vary '[FormatYaml] -> Set PoolId -> ByteString)
-> (Vary '[] -> Set PoolId -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> Set PoolId
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> Set PoolId -> ByteString)
-> (Vary '[] -> Set PoolId -> ByteString)
-> Vary '[FormatYaml]
-> Set PoolId
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> Set PoolId -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                ((Vary '[] -> Set PoolId -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml]
 -> Set PoolId
 -> ByteString)
-> (Vary '[] -> Set PoolId -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> Set PoolId
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> Set PoolId -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
            )
          (Set PoolId -> ByteString) -> Set PoolId -> ByteString
forall a b. (a -> b) -> a -> b
$ Set PoolId
stakePools

  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError
    (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output
 where
  encodeText :: Set PoolId -> ByteString
encodeText =
    [ByteString] -> ByteString
LBS.unlines
      ([ByteString] -> ByteString)
-> (Set PoolId -> [ByteString]) -> Set PoolId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item (Set PoolId) -> ByteString)
-> [Item (Set PoolId)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ByteString
strictTextToLazyBytestring (Text -> ByteString)
-> (Item (Set PoolId) -> Text) -> Item (Set PoolId) -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item (Set PoolId) -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32)
      ([Item (Set PoolId)] -> [ByteString])
-> (Set PoolId -> [Item (Set PoolId)])
-> Set PoolId
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PoolId -> [Item (Set PoolId)]
forall l. IsList l => l -> [Item l]
toList

writeFormattedOutput
  :: ToJSON a
  => Pretty a
  => Vary [FormatJson, FormatText, FormatYaml]
  -> Maybe (File b Out)
  -> a
  -> CIO e ()
writeFormattedOutput :: forall a b e.
(ToJSON a, Pretty a) =>
Vary '[FormatJson, FormatText, FormatYaml]
-> Maybe (File b 'Out) -> a -> CIO e ()
writeFormattedOutput Vary '[FormatJson, FormatText, FormatYaml]
format Maybe (File b 'Out)
mOutFile a
value = do
  let output :: ByteString
output =
        Vary '[FormatJson, FormatText, FormatYaml]
format
          Vary '[FormatJson, FormatText, FormatYaml]
-> (Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString
forall a. a -> a
id
                ((Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> ByteString)
-> (Vary '[FormatText, FormatYaml] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> a -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson a
value)
                ((Vary '[FormatText, FormatYaml] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> ByteString)
-> (Vary '[FormatYaml] -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatText
FormatText -> FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString (FilePath -> ByteString)
-> (Doc AnsiStyle -> FilePath) -> Doc AnsiStyle -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> FilePath
docToString (Doc AnsiStyle -> ByteString) -> Doc AnsiStyle -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Doc AnsiStyle
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
value)
                ((Vary '[FormatYaml] -> ByteString)
 -> Vary '[FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString) -> Vary '[FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> ByteString)
-> (Vary '[] -> ByteString) -> Vary '[FormatYaml] -> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> a -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml a
value)
                ((Vary '[] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
            )

  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
    Maybe (File b 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File b 'Out)
mOutFile ByteString
output

runQueryStakeDistributionCmd
  :: ()
  => Cmd.QueryStakeDistributionCmdArgs
  -> CIO e ()
runQueryStakeDistributionCmd :: forall e. QueryStakeDistributionCmdArgs -> CIO e ()
runQueryStakeDistributionCmd
  Cmd.QueryStakeDistributionCmdArgs
    { commons :: QueryStakeDistributionCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: QueryStakeDistributionCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryStakeDistributionCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    IO (Either AcquiringFailure (Either QueryCmdError ()))
-> RIO e (Either QueryCmdError ())
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
      ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
 -> IO (Either AcquiringFailure (Either QueryCmdError ())))
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
-> IO (Either AcquiringFailure (Either QueryCmdError ()))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   ()
 -> LocalStateQueryExpr
      BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ()))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
-> LocalStateQueryExpr
     BlockInMode ChainPoint QueryInMode () IO (Either QueryCmdError ())
forall a b. (a -> b) -> a -> b
$ do
          AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra
          let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
          Map PoolId Rational
result <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Map PoolId Rational)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Map PoolId Rational)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId Rational)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map PoolId Rational)))
queryStakeDistribution ShelleyBasedEra era
sbe)

          (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ())
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ()
forall a b. (a -> b) -> a -> b
$
            Vary '[FormatJson, FormatText, FormatYaml]
-> Maybe (File () 'Out)
-> Map PoolId Rational
-> ExceptT QueryCmdError IO ()
writeStakeDistribution Vary '[FormatJson, FormatText, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile Map PoolId Rational
result
      )
      RIO e (Either QueryCmdError ())
-> (RIO e (Either QueryCmdError ()) -> RIO e ()) -> RIO e ()
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError ()) -> RIO e ()
CIO e (Either QueryCmdError ()) -> CIO e ()
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

writeStakeDistribution
  :: Vary [FormatJson, FormatText, FormatYaml]
  -> Maybe (File () Out)
  -> Map PoolId Rational
  -> ExceptT QueryCmdError IO ()
writeStakeDistribution :: Vary '[FormatJson, FormatText, FormatYaml]
-> Maybe (File () 'Out)
-> Map PoolId Rational
-> ExceptT QueryCmdError IO ()
writeStakeDistribution Vary '[FormatJson, FormatText, FormatYaml]
format Maybe (File () 'Out)
mOutFile Map PoolId Rational
stakeDistrib = do
  let output :: ByteString
output =
        Vary '[FormatJson, FormatText, FormatYaml]
format
          Vary '[FormatJson, FormatText, FormatYaml]
-> (Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString
forall a. a -> a
id
                ((Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> ByteString)
-> (Vary '[FormatText, FormatYaml] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> Map PoolId Rational -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson Map PoolId Rational
stakeDistrib)
                ((Vary '[FormatText, FormatYaml] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> ByteString)
-> (Vary '[FormatYaml] -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatText
FormatText -> Text -> ByteString
strictTextToLazyBytestring Text
stakeDistributionText)
                ((Vary '[FormatYaml] -> ByteString)
 -> Vary '[FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString) -> Vary '[FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> ByteString)
-> (Vary '[] -> ByteString) -> Vary '[FormatYaml] -> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> Map PoolId Rational -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml Map PoolId Rational
stakeDistrib)
                ((Vary '[] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
            )

  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError
    (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output
 where
  stakeDistributionText :: Text
stakeDistributionText =
    [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
      [ Text
title
      , Int -> Text -> Text
Text.replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Text
"-"
      ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [PoolId -> Rational -> Text
showStakeDistr PoolId
poolId Rational
stakeFraction | (PoolId
poolId, Rational
stakeFraction) <- Map PoolId Rational -> [Item (Map PoolId Rational)]
forall l. IsList l => l -> [Item l]
toList Map PoolId Rational
stakeDistrib]
   where
    title :: Text
    title :: Text
title =
      Text
"                           PoolId                                 Stake frac"
    showStakeDistr :: PoolId -> Rational -> Text
    showStakeDistr :: PoolId -> Rational -> Text
showStakeDistr PoolId
poolId Rational
stakeFraction =
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ PoolId -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 PoolId
poolId
        , Text
"   "
        , FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
stakeFraction :: Double) FilePath
""
        ]

runQueryLeadershipScheduleCmd
  :: Cmd.QueryLeadershipScheduleCmdArgs
  -> CIO e ()
runQueryLeadershipScheduleCmd :: forall e. QueryLeadershipScheduleCmdArgs -> CIO e ()
runQueryLeadershipScheduleCmd
  Cmd.QueryLeadershipScheduleCmdArgs
    { commons :: QueryLeadershipScheduleCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , genesisFp :: QueryLeadershipScheduleCmdArgs -> GenesisFile
Cmd.genesisFp = GenesisFile FilePath
genFile
    , StakePoolKeyHashSource
poolColdVerKeyFile :: StakePoolKeyHashSource
poolColdVerKeyFile :: QueryLeadershipScheduleCmdArgs -> StakePoolKeyHashSource
Cmd.poolColdVerKeyFile
    , SigningKeyFile 'In
vrkSkeyFp :: SigningKeyFile 'In
vrkSkeyFp :: QueryLeadershipScheduleCmdArgs -> SigningKeyFile 'In
Cmd.vrkSkeyFp
    , EpochLeadershipSchedule
whichSchedule :: EpochLeadershipSchedule
whichSchedule :: QueryLeadershipScheduleCmdArgs -> EpochLeadershipSchedule
Cmd.whichSchedule
    , Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatText, FormatYaml]
outputFormat :: QueryLeadershipScheduleCmdArgs
-> Vary '[FormatJson, FormatText, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryLeadershipScheduleCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    PoolId
poolid <- StakePoolKeyHashSource -> RIO e PoolId
forall (m :: * -> *).
MonadIO m =>
StakePoolKeyHashSource -> m PoolId
getHashFromStakePoolKeyHashSource StakePoolKeyHashSource
poolColdVerKeyFile

    SigningKey VrfKey
vrkSkey <-
      IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> RIO e (SigningKey VrfKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
 -> RIO e (SigningKey VrfKey))
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> RIO e (SigningKey VrfKey)
forall a b. (a -> b) -> a -> b
$
        forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope @(SigningKey VrfKey) SigningKeyFile 'In
vrkSkeyFp

    ShelleyGenesis
shelleyGenesis <-
      ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis)
-> ExceptT GenesisCmdError IO ShelleyGenesis
-> RIO e ShelleyGenesis
forall a b. (a -> b) -> a -> b
$
        FilePath -> ExceptT GenesisCmdError IO ShelleyGenesis
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
FilePath -> t m ShelleyGenesis
decodeShelleyGenesisFile FilePath
genFile

    ExceptT QueryCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO () -> RIO e ())
-> (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
    -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> RIO e ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> RIO e ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            Era era
era <- (forall a.
 IO a
 -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a)
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT QueryCmdError m b -> ExceptT QueryCmdError n b
hoist IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall a.
IO a
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT QueryCmdError IO (Era era)
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Era era))
-> ExceptT QueryCmdError IO (Era era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Era era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ExceptT QueryCmdError IO (Era era)
forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra
            let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era

            PParams (ShelleyLedgerEra era)
pparams <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (PParams (ShelleyLedgerEra era))
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (PParams (ShelleyLedgerEra era))))
queryProtocolParameters ShelleyBasedEra era
sbe)
            ProtocolState era
ptclState <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (ProtocolState era)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ProtocolState era)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ProtocolState era)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ProtocolState era)))
queryProtocolState ShelleyBasedEra era
sbe)
            EraHistory
eraHistory <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  EraHistory
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  EraHistory
easyRunQueryEraHistory

            let eInfo :: EpochInfo (Either Text)
eInfo = EraHistory -> EpochInfo (Either Text)
toEpochInfo EraHistory
eraHistory

            EpochNo
curentEpoch <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (Either EraMismatch EpochNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EpochNo
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch EpochNo))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch EpochNo))
queryEpoch ShelleyBasedEra era
sbe)

            case EpochLeadershipSchedule
whichSchedule of
              EpochLeadershipSchedule
CurrentEpoch -> do
                let beo :: BabbageEraOnwards era
beo = Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era

                Serialised (PoolDistribution era)
serCurrentEpochState <-
                  LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (Serialised (PoolDistribution era))))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Serialised (PoolDistribution era))
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Serialised (PoolDistribution era))))
forall era block point r.
BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Serialised (PoolDistribution era))))
queryPoolDistribution BabbageEraOnwards era
beo (Set PoolId -> Maybe (Set PoolId)
forall a. a -> Maybe a
Just (PoolId -> Set PoolId
forall a. a -> Set a
Set.singleton PoolId
poolid)))

                ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ do
                  Set SlotNo
schedule <-
                    (LeadershipError -> QueryCmdError)
-> ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT QueryCmdError IO (Set SlotNo)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT LeadershipError -> QueryCmdError
QueryCmdLeaderShipError (ExceptT LeadershipError IO (Set SlotNo)
 -> ExceptT QueryCmdError IO (Set SlotNo))
-> ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT QueryCmdError IO (Set SlotNo)
forall a b. (a -> b) -> a -> b
$
                      Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither (Either LeadershipError (Set SlotNo)
 -> ExceptT LeadershipError IO (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo)
forall a b. (a -> b) -> a -> b
$
                        Era era
-> (EraCommonConstraints era =>
    Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => Either LeadershipError (Set SlotNo))
 -> Either LeadershipError (Set SlotNo))
-> (EraCommonConstraints era =>
    Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
forall a b. (a -> b) -> a -> b
$
                          ShelleyBasedEra era
-> ShelleyGenesis
-> EpochInfo (Either Text)
-> PParams (ShelleyLedgerEra era)
-> ProtocolState era
-> PoolId
-> SigningKey VrfKey
-> Serialised (PoolDistribution era)
-> EpochNo
-> Either LeadershipError (Set SlotNo)
forall era.
ShelleyBasedEra era
-> ShelleyGenesis
-> EpochInfo (Either Text)
-> PParams (ShelleyLedgerEra era)
-> ProtocolState era
-> PoolId
-> SigningKey VrfKey
-> Serialised (PoolDistribution era)
-> EpochNo
-> Either LeadershipError (Set SlotNo)
currentEpochEligibleLeadershipSlots
                            ShelleyBasedEra era
sbe
                            ShelleyGenesis
shelleyGenesis
                            EpochInfo (Either Text)
eInfo
                            PParams (ShelleyLedgerEra era)
pparams
                            ProtocolState era
ptclState
                            PoolId
poolid
                            SigningKey VrfKey
vrkSkey
                            Serialised (PoolDistribution era)
serCurrentEpochState
                            EpochNo
curentEpoch

                  Maybe (File () 'Out)
-> EpochInfo (Either Text)
-> ShelleyGenesis
-> Set SlotNo
-> ExceptT QueryCmdError IO ()
writeSchedule Maybe (File () 'Out)
mOutFile EpochInfo (Either Text)
eInfo ShelleyGenesis
shelleyGenesis Set SlotNo
schedule
              EpochLeadershipSchedule
NextEpoch -> do
                SerialisedCurrentEpochState era
serCurrentEpochState <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (SerialisedCurrentEpochState era)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (SerialisedCurrentEpochState era)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedCurrentEpochState era)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedCurrentEpochState era)))
queryCurrentEpochState ShelleyBasedEra era
sbe)

                ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ do
                  ChainTip
tip <- IO ChainTip -> ExceptT QueryCmdError IO ChainTip
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainTip -> ExceptT QueryCmdError IO ChainTip)
-> IO ChainTip -> ExceptT QueryCmdError IO ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo -> IO ChainTip
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo -> m ChainTip
getLocalChainTip LocalNodeConnectInfo
nodeConnInfo

                  Set SlotNo
schedule <-
                    (LeadershipError -> QueryCmdError)
-> ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT QueryCmdError IO (Set SlotNo)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT LeadershipError -> QueryCmdError
QueryCmdLeaderShipError (ExceptT LeadershipError IO (Set SlotNo)
 -> ExceptT QueryCmdError IO (Set SlotNo))
-> ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT QueryCmdError IO (Set SlotNo)
forall a b. (a -> b) -> a -> b
$
                      Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither (Either LeadershipError (Set SlotNo)
 -> ExceptT LeadershipError IO (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo)
forall a b. (a -> b) -> a -> b
$
                        Era era
-> (EraCommonConstraints era =>
    Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => Either LeadershipError (Set SlotNo))
 -> Either LeadershipError (Set SlotNo))
-> (EraCommonConstraints era =>
    Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
forall a b. (a -> b) -> a -> b
$
                          ShelleyBasedEra era
-> ShelleyGenesis
-> SerialisedCurrentEpochState era
-> ProtocolState era
-> PoolId
-> SigningKey VrfKey
-> PParams (ShelleyLedgerEra era)
-> EpochInfo (Either Text)
-> (ChainTip, EpochNo)
-> Either LeadershipError (Set SlotNo)
forall era.
ShelleyBasedEra era
-> ShelleyGenesis
-> SerialisedCurrentEpochState era
-> ProtocolState era
-> PoolId
-> SigningKey VrfKey
-> PParams (ShelleyLedgerEra era)
-> EpochInfo (Either Text)
-> (ChainTip, EpochNo)
-> Either LeadershipError (Set SlotNo)
nextEpochEligibleLeadershipSlots
                            ShelleyBasedEra era
sbe
                            ShelleyGenesis
shelleyGenesis
                            SerialisedCurrentEpochState era
serCurrentEpochState
                            ProtocolState era
ptclState
                            PoolId
poolid
                            SigningKey VrfKey
vrkSkey
                            PParams (ShelleyLedgerEra era)
pparams
                            EpochInfo (Either Text)
eInfo
                            (ChainTip
tip, EpochNo
curentEpoch)

                  Maybe (File () 'Out)
-> EpochInfo (Either Text)
-> ShelleyGenesis
-> Set SlotNo
-> ExceptT QueryCmdError IO ()
writeSchedule Maybe (File () 'Out)
mOutFile EpochInfo (Either Text)
eInfo ShelleyGenesis
shelleyGenesis Set SlotNo
schedule
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left
   where
    writeSchedule :: Maybe (File () 'Out)
-> EpochInfo (Either Text)
-> ShelleyGenesis
-> Set SlotNo
-> ExceptT QueryCmdError IO ()
writeSchedule Maybe (File () 'Out)
mOutFile' EpochInfo (Either Text)
eInfo ShelleyGenesis
shelleyGenesis Set SlotNo
schedule = do
      let start :: SystemStart
start = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> UTCTime
sgSystemStart ShelleyGenesis
shelleyGenesis
          output :: ByteString
output =
            Vary '[FormatJson, FormatText, FormatYaml]
outputFormat
              Vary '[FormatJson, FormatText, FormatYaml]
-> (Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString
forall a. a -> a
id
                    ((Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> ByteString)
-> (Vary '[FormatText, FormatYaml] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> [Value]
leadershipScheduleToJson Set SlotNo
schedule EpochInfo (Either Text)
eInfo SystemStart
start)
                    ((Vary '[FormatText, FormatYaml] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> ByteString)
-> (Vary '[FormatYaml] -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatText
FormatText -> Text -> ByteString
strictTextToLazyBytestring (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> Text
leadershipScheduleToText Set SlotNo
schedule EpochInfo (Either Text)
eInfo SystemStart
start)
                    ((Vary '[FormatYaml] -> ByteString)
 -> Vary '[FormatText, FormatYaml] -> ByteString)
-> ((Vary '[] -> ByteString) -> Vary '[FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatText, FormatYaml]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> ByteString)
-> (Vary '[] -> ByteString) -> Vary '[FormatYaml] -> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> [Value]
leadershipScheduleToJson Set SlotNo
schedule EpochInfo (Either Text)
eInfo SystemStart
start)
                    ((Vary '[] -> ByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
                )

      (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError
        (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
        (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile' ByteString
output

    leadershipScheduleToText
      :: Set SlotNo
      -> EpochInfo (Either Text)
      -> SystemStart
      -> Text
    leadershipScheduleToText :: Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> Text
leadershipScheduleToText Set SlotNo
leadershipSlots EpochInfo (Either Text)
eInfo SystemStart
sStart = do
      [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        Text
title
          Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Text -> Text
Text.replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Text
"-"
          Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [SlotNo -> EpochInfo (Either Text) -> SystemStart -> Text
showLeadershipSlot SlotNo
slot EpochInfo (Either Text)
eInfo SystemStart
sStart | SlotNo
slot <- Set SlotNo -> [Item (Set SlotNo)]
forall l. IsList l => l -> [Item l]
toList Set SlotNo
leadershipSlots]
     where
      title :: Text
      title :: Text
title =
        Text
"     SlotNo                          UTC Time              "

      showLeadershipSlot
        :: SlotNo
        -> EpochInfo (Either Text)
        -> SystemStart
        -> Text
      showLeadershipSlot :: SlotNo -> EpochInfo (Either Text) -> SystemStart -> Text
showLeadershipSlot lSlot :: SlotNo
lSlot@(SlotNo Word64
sn) EpochInfo (Either Text)
eInfo' SystemStart
sStart' =
        case EpochInfo (Either Text)
-> SystemStart -> SlotNo -> Either Text UTCTime
forall (m :: * -> *).
(HasCallStack, Monad m) =>
EpochInfo m -> SystemStart -> SlotNo -> m UTCTime
epochInfoSlotToUTCTime EpochInfo (Either Text)
eInfo' SystemStart
sStart' SlotNo
lSlot of
          Right UTCTime
slotTime ->
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"     "
              , FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Word64 -> FilePath
forall a. Show a => a -> FilePath
show Word64
sn
              , Text
"                   "
              , FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> FilePath
forall a. Show a => a -> FilePath
show UTCTime
slotTime
              ]
          Left Text
err ->
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"     "
              , FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Word64 -> FilePath
forall a. Show a => a -> FilePath
show Word64
sn
              , Text
"                   "
              , Text
err
              ]
    leadershipScheduleToJson
      :: Set SlotNo
      -> EpochInfo (Either Text)
      -> SystemStart
      -> [Aeson.Value]
    leadershipScheduleToJson :: Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> [Value]
leadershipScheduleToJson Set SlotNo
leadershipSlots EpochInfo (Either Text)
eInfo SystemStart
sStart =
      SlotNo -> Value
showLeadershipSlot (SlotNo -> Value) -> [SlotNo] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SlotNo] -> [SlotNo]
forall a. Ord a => [a] -> [a]
List.sort (Set SlotNo -> [Item (Set SlotNo)]
forall l. IsList l => l -> [Item l]
toList Set SlotNo
leadershipSlots)
     where
      showLeadershipSlot :: SlotNo -> Aeson.Value
      showLeadershipSlot :: SlotNo -> Value
showLeadershipSlot lSlot :: SlotNo
lSlot@(SlotNo Word64
sn) =
        case EpochInfo (Either Text)
-> SystemStart -> SlotNo -> Either Text UTCTime
forall (m :: * -> *).
(HasCallStack, Monad m) =>
EpochInfo m -> SystemStart -> SlotNo -> m UTCTime
epochInfoSlotToUTCTime EpochInfo (Either Text)
eInfo SystemStart
sStart SlotNo
lSlot of
          Right UTCTime
slotTime ->
            [Pair] -> Value
Aeson.object
              [ Key
"slotNumber" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Word64
sn
              , Key
"slotTime" Key -> UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= UTCTime
slotTime
              ]
          Left Text
err ->
            [Pair] -> Value
Aeson.object
              [ Key
"slotNumber" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Word64
sn
              , Key
"error" Key -> FilePath -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text -> FilePath
Text.unpack Text
err
              ]

runQueryConstitution
  :: Cmd.QueryNoArgCmdArgs era
  -> CIO e ()
runQueryConstitution :: forall era e. QueryNoArgCmdArgs era -> CIO e ()
runQueryConstitution
  Cmd.QueryNoArgCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. QueryNoArgCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryNoArgCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: forall era. QueryNoArgCmdArgs era -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. QueryNoArgCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    Constitution (ShelleyLedgerEra era)
constitution <- ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era))
-> RIO e (Constitution (ShelleyLedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era))
 -> RIO e (Constitution (ShelleyLedgerEra era)))
-> ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era))
-> RIO e (Constitution (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
 -> ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
queryConstitution ConwayEraOnwards era
eon

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> Constitution (ShelleyLedgerEra era)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Constitution (ShelleyLedgerEra era)
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> Constitution (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Constitution (ShelleyLedgerEra era)
 -> ByteString)
-> ((Vary '[] -> Constitution (ShelleyLedgerEra era) -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> Constitution (ShelleyLedgerEra era)
    -> ByteString)
-> (Vary '[] -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Constitution (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> (Vary '[FormatYaml]
    -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Constitution (ShelleyLedgerEra era)
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> Constitution (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml]
  -> Constitution (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Constitution (ShelleyLedgerEra era)
 -> ByteString)
-> ((Vary '[] -> Constitution (ShelleyLedgerEra era) -> ByteString)
    -> Vary '[FormatYaml]
    -> Constitution (ShelleyLedgerEra era)
    -> ByteString)
-> (Vary '[] -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Constitution (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> (Vary '[] -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatYaml]
-> Constitution (ShelleyLedgerEra era)
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> Constitution (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> Constitution (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Constitution (ShelleyLedgerEra era)
 -> ByteString)
-> (Vary '[] -> Constitution (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Constitution (ShelleyLedgerEra era)
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> Constitution (ShelleyLedgerEra era) -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (Constitution (ShelleyLedgerEra era) -> ByteString)
-> Constitution (ShelleyLedgerEra era) -> ByteString
forall a b. (a -> b) -> a -> b
$ Constitution (ShelleyLedgerEra era)
constitution

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryGovState
  :: Cmd.QueryNoArgCmdArgs era
  -> CIO e ()
runQueryGovState :: forall era e. QueryNoArgCmdArgs era -> CIO e ()
runQueryGovState
  Cmd.QueryNoArgCmdArgs
    { ConwayEraOnwards era
eon :: forall era. QueryNoArgCmdArgs era -> ConwayEraOnwards era
eon :: ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryNoArgCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Vary '[FormatJson, FormatYaml]
outputFormat :: forall era. QueryNoArgCmdArgs era -> Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: forall era. QueryNoArgCmdArgs era -> Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    ConwayGovState (ShelleyLedgerEra era)
govState <- ExceptT QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era))
-> RIO e (ConwayGovState (ShelleyLedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era))
 -> RIO e (ConwayGovState (ShelleyLedgerEra era)))
-> ExceptT QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era))
-> RIO e (ConwayGovState (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ConwayGovState (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (ConwayGovState (ShelleyLedgerEra era))))
 -> ExceptT
      QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ConwayGovState (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GovState (ShelleyLedgerEra era))))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GovState (ShelleyLedgerEra era))))
queryGovState ConwayEraOnwards era
eon

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> ConwayGovState (ShelleyLedgerEra era)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> ConwayGovState (ShelleyLedgerEra era)
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> ConwayGovState (ShelleyLedgerEra era)
 -> ByteString)
-> ((Vary '[]
     -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> ConwayGovState (ShelleyLedgerEra era)
    -> ByteString)
-> (Vary '[]
    -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> ConwayGovState (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> (Vary '[FormatYaml]
    -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> ConwayGovState (ShelleyLedgerEra era)
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> ConwayGovState (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml]
  -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> ConwayGovState (ShelleyLedgerEra era)
 -> ByteString)
-> ((Vary '[]
     -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
    -> Vary '[FormatYaml]
    -> ConwayGovState (ShelleyLedgerEra era)
    -> ByteString)
-> (Vary '[]
    -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> ConwayGovState (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> (Vary '[]
    -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatYaml]
-> ConwayGovState (ShelleyLedgerEra era)
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> ConwayGovState (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> ConwayGovState (ShelleyLedgerEra era)
 -> ByteString)
-> (Vary '[]
    -> ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> ConwayGovState (ShelleyLedgerEra era)
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> ConwayGovState (ShelleyLedgerEra era) -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (ConwayGovState (ShelleyLedgerEra era) -> ByteString)
-> ConwayGovState (ShelleyLedgerEra era) -> ByteString
forall a b. (a -> b) -> a -> b
$ ConwayGovState (ShelleyLedgerEra era)
govState

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryRatifyState
  :: Cmd.QueryNoArgCmdArgs era
  -> CIO e ()
runQueryRatifyState :: forall era e. QueryNoArgCmdArgs era -> CIO e ()
runQueryRatifyState
  Cmd.QueryNoArgCmdArgs
    { ConwayEraOnwards era
eon :: forall era. QueryNoArgCmdArgs era -> ConwayEraOnwards era
eon :: ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryNoArgCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Vary '[FormatJson, FormatYaml]
outputFormat :: forall era. QueryNoArgCmdArgs era -> Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: forall era. QueryNoArgCmdArgs era -> Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    RatifyState (ShelleyLedgerEra era)
ratifyState <- ExceptT QueryCmdError IO (RatifyState (ShelleyLedgerEra era))
-> RIO e (RatifyState (ShelleyLedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (RatifyState (ShelleyLedgerEra era))
 -> RIO e (RatifyState (ShelleyLedgerEra era)))
-> ExceptT QueryCmdError IO (RatifyState (ShelleyLedgerEra era))
-> RIO e (RatifyState (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (RatifyState (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (RatifyState (ShelleyLedgerEra era))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (RatifyState (ShelleyLedgerEra era))))
 -> ExceptT QueryCmdError IO (RatifyState (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (RatifyState (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (RatifyState (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (RatifyState (ShelleyLedgerEra era))))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (RatifyState (ShelleyLedgerEra era))))
queryRatifyState ConwayEraOnwards era
eon

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> RatifyState (ShelleyLedgerEra era)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> RatifyState (ShelleyLedgerEra era)
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> RatifyState (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> RatifyState (ShelleyLedgerEra era)
 -> ByteString)
-> ((Vary '[] -> RatifyState (ShelleyLedgerEra era) -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> RatifyState (ShelleyLedgerEra era)
    -> ByteString)
-> (Vary '[] -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> RatifyState (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> (Vary '[FormatYaml]
    -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> RatifyState (ShelleyLedgerEra era)
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> RatifyState (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml]
  -> RatifyState (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> RatifyState (ShelleyLedgerEra era)
 -> ByteString)
-> ((Vary '[] -> RatifyState (ShelleyLedgerEra era) -> ByteString)
    -> Vary '[FormatYaml]
    -> RatifyState (ShelleyLedgerEra era)
    -> ByteString)
-> (Vary '[] -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> RatifyState (ShelleyLedgerEra era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> (Vary '[] -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatYaml]
-> RatifyState (ShelleyLedgerEra era)
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> RatifyState (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> RatifyState (ShelleyLedgerEra era) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> RatifyState (ShelleyLedgerEra era)
 -> ByteString)
-> (Vary '[] -> RatifyState (ShelleyLedgerEra era) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> RatifyState (ShelleyLedgerEra era)
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RatifyState (ShelleyLedgerEra era) -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (RatifyState (ShelleyLedgerEra era) -> ByteString)
-> RatifyState (ShelleyLedgerEra era) -> ByteString
forall a b. (a -> b) -> a -> b
$ RatifyState (ShelleyLedgerEra era)
ratifyState

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryFuturePParams
  :: Cmd.QueryNoArgCmdArgs era
  -> CIO e ()
runQueryFuturePParams :: forall era e. QueryNoArgCmdArgs era -> CIO e ()
runQueryFuturePParams
  Cmd.QueryNoArgCmdArgs
    { ConwayEraOnwards era
eon :: forall era. QueryNoArgCmdArgs era -> ConwayEraOnwards era
eon :: ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryNoArgCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Vary '[FormatJson, FormatYaml]
outputFormat :: forall era. QueryNoArgCmdArgs era -> Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: forall era. QueryNoArgCmdArgs era -> Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe (PParams (ShelleyLedgerEra era))
futurePParams <- ExceptT QueryCmdError IO (Maybe (PParams (ShelleyLedgerEra era)))
-> RIO e (Maybe (PParams (ShelleyLedgerEra era)))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (Maybe (PParams (ShelleyLedgerEra era)))
 -> RIO e (Maybe (PParams (ShelleyLedgerEra era))))
-> ExceptT
     QueryCmdError IO (Maybe (PParams (ShelleyLedgerEra era)))
-> RIO e (Maybe (PParams (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Maybe (PParams (ShelleyLedgerEra era)))))
-> ExceptT
     QueryCmdError IO (Maybe (PParams (ShelleyLedgerEra era)))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Maybe (PParams (ShelleyLedgerEra era)))))
 -> ExceptT
      QueryCmdError IO (Maybe (PParams (ShelleyLedgerEra era))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Maybe (PParams (ShelleyLedgerEra era)))))
-> ExceptT
     QueryCmdError IO (Maybe (PParams (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Maybe (PParams (ShelleyLedgerEra era)))))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Maybe (PParams (ShelleyLedgerEra era)))))
queryFuturePParams ConwayEraOnwards era
eon

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> Maybe (PParams (ShelleyLedgerEra era))
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe (PParams (ShelleyLedgerEra era))
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Maybe (PParams (ShelleyLedgerEra era))
 -> ByteString)
-> ((Vary '[]
     -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> Maybe (PParams (ShelleyLedgerEra era))
    -> ByteString)
-> (Vary '[]
    -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe (PParams (ShelleyLedgerEra era))
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson
 -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> (Vary '[FormatYaml]
    -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe (PParams (ShelleyLedgerEra era))
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml]
  -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Maybe (PParams (ShelleyLedgerEra era))
 -> ByteString)
-> ((Vary '[]
     -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
    -> Vary '[FormatYaml]
    -> Maybe (PParams (ShelleyLedgerEra era))
    -> ByteString)
-> (Vary '[]
    -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe (PParams (ShelleyLedgerEra era))
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml
 -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> (Vary '[]
    -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatYaml]
-> Maybe (PParams (ShelleyLedgerEra era))
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Maybe (PParams (ShelleyLedgerEra era))
 -> ByteString)
-> (Vary '[]
    -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Maybe (PParams (ShelleyLedgerEra era))
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (Maybe (PParams (ShelleyLedgerEra era)) -> ByteString)
-> Maybe (PParams (ShelleyLedgerEra era)) -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe (PParams (ShelleyLedgerEra era))
futurePParams

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryDRepState
  :: Cmd.QueryDRepStateCmdArgs era
  -> CIO e ()
runQueryDRepState :: forall era e. QueryDRepStateCmdArgs era -> CIO e ()
runQueryDRepState
  Cmd.QueryDRepStateCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. QueryDRepStateCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , drepHashSources :: forall era. QueryDRepStateCmdArgs era -> AllOrOnly DRepHashSource
Cmd.drepHashSources = AllOrOnly DRepHashSource
drepHashSources'
    , IncludeStake
includeStake :: IncludeStake
includeStake :: forall era. QueryDRepStateCmdArgs era -> IncludeStake
Cmd.includeStake
    , commons :: forall era. QueryDRepStateCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: forall era.
QueryDRepStateCmdArgs era -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. QueryDRepStateCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    let drepHashSources :: [DRepHashSource]
drepHashSources = case AllOrOnly DRepHashSource
drepHashSources' of AllOrOnly DRepHashSource
All -> []; Only [DRepHashSource]
l -> [DRepHashSource]
l
    [Credential 'DRepRole]
drepCreds <- (DRepHashSource -> RIO e (Credential 'DRepRole))
-> [DRepHashSource] -> RIO e [Credential 'DRepRole]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DRepHashSource -> RIO e (Credential 'DRepRole)
DRepHashSource -> CIO e (Credential 'DRepRole)
forall e. DRepHashSource -> CIO e (Credential 'DRepRole)
readDRepCredential [DRepHashSource]
drepHashSources

    Map (Credential 'DRepRole) DRepState
drepState <- ExceptT QueryCmdError IO (Map (Credential 'DRepRole) DRepState)
-> RIO e (Map (Credential 'DRepRole) DRepState)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (Map (Credential 'DRepRole) DRepState)
 -> RIO e (Map (Credential 'DRepRole) DRepState))
-> ExceptT QueryCmdError IO (Map (Credential 'DRepRole) DRepState)
-> RIO e (Map (Credential 'DRepRole) DRepState)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
-> ExceptT QueryCmdError IO (Map (Credential 'DRepRole) DRepState)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
 -> ExceptT QueryCmdError IO (Map (Credential 'DRepRole) DRepState))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
-> ExceptT QueryCmdError IO (Map (Credential 'DRepRole) DRepState)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set (Credential 'DRepRole)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
forall era block point r.
ConwayEraOnwards era
-> Set (Credential 'DRepRole)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
queryDRepState ConwayEraOnwards era
eon (Set (Credential 'DRepRole)
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either
         UnsupportedNtcVersionError
         (Either EraMismatch (Map (Credential 'DRepRole) DRepState))))
-> Set (Credential 'DRepRole)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (Credential 'DRepRole) DRepState)))
forall a b. (a -> b) -> a -> b
$ [Item (Set (Credential 'DRepRole))] -> Set (Credential 'DRepRole)
forall l. IsList l => [Item l] -> l
fromList [Item (Set (Credential 'DRepRole))]
[Credential 'DRepRole]
drepCreds

    Map DRep Lovelace
drepStakeDistribution <-
      case IncludeStake
includeStake of
        IncludeStake
Cmd.WithStake ->
          ExceptT QueryCmdError IO (Map DRep Lovelace)
-> RIO e (Map DRep Lovelace)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (Map DRep Lovelace)
 -> RIO e (Map DRep Lovelace))
-> ExceptT QueryCmdError IO (Map DRep Lovelace)
-> RIO e (Map DRep Lovelace)
forall a b. (a -> b) -> a -> b
$
            LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map DRep Lovelace)))
-> ExceptT QueryCmdError IO (Map DRep Lovelace)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Map DRep Lovelace)))
 -> ExceptT QueryCmdError IO (Map DRep Lovelace))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map DRep Lovelace)))
-> ExceptT QueryCmdError IO (Map DRep Lovelace)
forall a b. (a -> b) -> a -> b
$
              ConwayEraOnwards era
-> Set DRep
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map DRep Lovelace)))
forall era block point r.
ConwayEraOnwards era
-> Set DRep
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map DRep Lovelace)))
queryDRepStakeDistribution ConwayEraOnwards era
eon ([Item (Set DRep)] -> Set DRep
forall l. IsList l => [Item l] -> l
fromList ([Item (Set DRep)] -> Set DRep) -> [Item (Set DRep)] -> Set DRep
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> DRep
L.DRepCredential (Credential 'DRepRole -> DRep) -> [Credential 'DRepRole] -> [DRep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Credential 'DRepRole]
drepCreds)
        IncludeStake
Cmd.NoStake -> Map DRep Lovelace -> RIO e (Map DRep Lovelace)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return Map DRep Lovelace
forall a. Monoid a => a
mempty

    let [(Credential 'DRepRole, DRepState)]
assocs :: [(L.Credential L.DRepRole, L.DRepState)] = Map (Credential 'DRepRole) DRepState
-> [(Credential 'DRepRole, DRepState)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map (Credential 'DRepRole) DRepState
drepState
        drepStateOutputs :: [QueryDRepStateOutput]
drepStateOutputs = Map DRep Lovelace
-> (Credential 'DRepRole, DRepState) -> QueryDRepStateOutput
toDRepStateOutput Map DRep Lovelace
drepStakeDistribution ((Credential 'DRepRole, DRepState) -> QueryDRepStateOutput)
-> [(Credential 'DRepRole, DRepState)] -> [QueryDRepStateOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Credential 'DRepRole, DRepState)]
assocs

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> [QueryDRepStateOutput] -> ByteString)
-> [QueryDRepStateOutput]
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> [QueryDRepStateOutput] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [QueryDRepStateOutput]
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> [QueryDRepStateOutput] -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> [QueryDRepStateOutput]
 -> ByteString)
-> ((Vary '[] -> [QueryDRepStateOutput] -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> [QueryDRepStateOutput]
    -> ByteString)
-> (Vary '[] -> [QueryDRepStateOutput] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [QueryDRepStateOutput]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> [QueryDRepStateOutput] -> ByteString)
-> (Vary '[FormatYaml] -> [QueryDRepStateOutput] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [QueryDRepStateOutput]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> [QueryDRepStateOutput] -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml] -> [QueryDRepStateOutput] -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> [QueryDRepStateOutput]
 -> ByteString)
-> ((Vary '[] -> [QueryDRepStateOutput] -> ByteString)
    -> Vary '[FormatYaml] -> [QueryDRepStateOutput] -> ByteString)
-> (Vary '[] -> [QueryDRepStateOutput] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [QueryDRepStateOutput]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> [QueryDRepStateOutput] -> ByteString)
-> (Vary '[] -> [QueryDRepStateOutput] -> ByteString)
-> Vary '[FormatYaml]
-> [QueryDRepStateOutput]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> [QueryDRepStateOutput] -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> [QueryDRepStateOutput] -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> [QueryDRepStateOutput]
 -> ByteString)
-> (Vary '[] -> [QueryDRepStateOutput] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [QueryDRepStateOutput]
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> [QueryDRepStateOutput] -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            ([QueryDRepStateOutput] -> ByteString)
-> [QueryDRepStateOutput] -> ByteString
forall a b. (a -> b) -> a -> b
$ [QueryDRepStateOutput]
drepStateOutputs

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output
   where
    toDRepStateOutput
      :: ()
      => Map L.DRep Lovelace
      -> (L.Credential L.DRepRole, L.DRepState)
      -> QueryDRepStateOutput
    toDRepStateOutput :: Map DRep Lovelace
-> (Credential 'DRepRole, DRepState) -> QueryDRepStateOutput
toDRepStateOutput Map DRep Lovelace
stakeDistr (Credential 'DRepRole
cred, DRepState
ds) =
      Credential 'DRepRole
-> EpochNo
-> Maybe Anchor
-> Lovelace
-> IncludeStake
-> Maybe Lovelace
-> QueryDRepStateOutput
QueryDRepStateOutput
        Credential 'DRepRole
cred
        (DRepState
ds DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
L.drepExpiryL)
        (StrictMaybe Anchor -> Maybe Anchor
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (StrictMaybe Anchor -> Maybe Anchor)
-> StrictMaybe Anchor -> Maybe Anchor
forall a b. (a -> b) -> a -> b
$ DRepState
ds DRepState
-> Getting (StrictMaybe Anchor) DRepState (StrictMaybe Anchor)
-> StrictMaybe Anchor
forall s a. s -> Getting a s a -> a
^. Getting (StrictMaybe Anchor) DRepState (StrictMaybe Anchor)
Lens' DRepState (StrictMaybe Anchor)
L.drepAnchorL)
        (DRepState
ds DRepState -> Getting Lovelace DRepState Lovelace -> Lovelace
forall s a. s -> Getting a s a -> a
^. Getting Lovelace DRepState Lovelace
Lens' DRepState Lovelace
L.drepDepositL)
        IncludeStake
includeStake
        (DRep -> Map DRep Lovelace -> Maybe Lovelace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Credential 'DRepRole -> DRep
L.DRepCredential Credential 'DRepRole
cred) Map DRep Lovelace
stakeDistr)

runQueryDRepStakeDistribution
  :: Cmd.QueryDRepStakeDistributionCmdArgs era
  -> CIO e ()
runQueryDRepStakeDistribution :: forall era e. QueryDRepStakeDistributionCmdArgs era -> CIO e ()
runQueryDRepStakeDistribution
  Cmd.QueryDRepStakeDistributionCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
QueryDRepStakeDistributionCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryDRepStakeDistributionCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , drepHashSources :: forall era.
QueryDRepStakeDistributionCmdArgs era -> AllOrOnly DRepHashSource
Cmd.drepHashSources = AllOrOnly DRepHashSource
drepHashSources'
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: forall era.
QueryDRepStakeDistributionCmdArgs era
-> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era.
QueryDRepStakeDistributionCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    let drepFromSource :: DRepHashSource -> RIO e DRep
drepFromSource =
          (Credential 'DRepRole -> DRep)
-> RIO e (Credential 'DRepRole) -> RIO e DRep
forall a b. (a -> b) -> RIO e a -> RIO e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Credential 'DRepRole -> DRep
L.DRepCredential (RIO e (Credential 'DRepRole) -> RIO e DRep)
-> (DRepHashSource -> RIO e (Credential 'DRepRole))
-> DRepHashSource
-> RIO e DRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepHashSource -> RIO e (Credential 'DRepRole)
DRepHashSource -> CIO e (Credential 'DRepRole)
forall e. DRepHashSource -> CIO e (Credential 'DRepRole)
readDRepCredential
        drepHashSources :: [DRepHashSource]
drepHashSources = case AllOrOnly DRepHashSource
drepHashSources' of
          AllOrOnly DRepHashSource
All -> []
          Only [DRepHashSource]
l -> [DRepHashSource]
l
    Set DRep
dreps <- [Item (Set DRep)] -> Set DRep
[DRep] -> Set DRep
forall l. IsList l => [Item l] -> l
fromList ([DRep] -> Set DRep) -> RIO e [DRep] -> RIO e (Set DRep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DRepHashSource -> RIO e DRep) -> [DRepHashSource] -> RIO e [DRep]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DRepHashSource -> RIO e DRep
forall {e}. DRepHashSource -> RIO e DRep
drepFromSource [DRepHashSource]
drepHashSources

    Map DRep Lovelace
drepStakeDistribution <-
      ExceptT QueryCmdError IO (Map DRep Lovelace)
-> RIO e (Map DRep Lovelace)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (Map DRep Lovelace)
 -> RIO e (Map DRep Lovelace))
-> ExceptT QueryCmdError IO (Map DRep Lovelace)
-> RIO e (Map DRep Lovelace)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map DRep Lovelace)))
-> ExceptT QueryCmdError IO (Map DRep Lovelace)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Map DRep Lovelace)))
 -> ExceptT QueryCmdError IO (Map DRep Lovelace))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map DRep Lovelace)))
-> ExceptT QueryCmdError IO (Map DRep Lovelace)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set DRep
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map DRep Lovelace)))
forall era block point r.
ConwayEraOnwards era
-> Set DRep
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map DRep Lovelace)))
queryDRepStakeDistribution ConwayEraOnwards era
eon Set DRep
dreps

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> Map DRep Lovelace -> ByteString)
-> Map DRep Lovelace
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml] -> Map DRep Lovelace -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map DRep Lovelace
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> Map DRep Lovelace -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Map DRep Lovelace
 -> ByteString)
-> ((Vary '[] -> Map DRep Lovelace -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> Map DRep Lovelace
    -> ByteString)
-> (Vary '[] -> Map DRep Lovelace -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map DRep Lovelace
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> Map DRep Lovelace -> ByteString)
-> (Vary '[FormatYaml] -> Map DRep Lovelace -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map DRep Lovelace
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> Map DRep Lovelace -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml] -> Map DRep Lovelace -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Map DRep Lovelace
 -> ByteString)
-> ((Vary '[] -> Map DRep Lovelace -> ByteString)
    -> Vary '[FormatYaml] -> Map DRep Lovelace -> ByteString)
-> (Vary '[] -> Map DRep Lovelace -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map DRep Lovelace
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> Map DRep Lovelace -> ByteString)
-> (Vary '[] -> Map DRep Lovelace -> ByteString)
-> Vary '[FormatYaml]
-> Map DRep Lovelace
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> Map DRep Lovelace -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> Map DRep Lovelace -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Map DRep Lovelace
 -> ByteString)
-> (Vary '[] -> Map DRep Lovelace -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Map DRep Lovelace
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> Map DRep Lovelace -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (Map DRep Lovelace -> ByteString)
-> Map DRep Lovelace -> ByteString
forall a b. (a -> b) -> a -> b
$ Map DRep Lovelace
drepStakeDistribution

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQuerySPOStakeDistribution
  :: Cmd.QuerySPOStakeDistributionCmdArgs era
  -> CIO e ()
runQuerySPOStakeDistribution :: forall era e. QuerySPOStakeDistributionCmdArgs era -> CIO e ()
runQuerySPOStakeDistribution
  Cmd.QuerySPOStakeDistributionCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
QuerySPOStakeDistributionCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QuerySPOStakeDistributionCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , spoHashSources :: forall era.
QuerySPOStakeDistributionCmdArgs era -> AllOrOnly SPOHashSource
Cmd.spoHashSources = AllOrOnly SPOHashSource
spoHashSources'
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: forall era.
QuerySPOStakeDistributionCmdArgs era
-> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era.
QuerySPOStakeDistributionCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    let spoFromSource :: SPOHashSource -> CIO e (KeyHash 'StakePool)
spoFromSource = SPOHashSource -> CIO e (KeyHash 'StakePool)
forall e. SPOHashSource -> CIO e (KeyHash 'StakePool)
readSPOCredential
        spoHashSources :: [SPOHashSource]
spoHashSources = case AllOrOnly SPOHashSource
spoHashSources' of
          AllOrOnly SPOHashSource
All -> []
          Only [SPOHashSource]
l -> [SPOHashSource]
l

    Set (KeyHash 'StakePool)
spos <- [Item (Set (KeyHash 'StakePool))] -> Set (KeyHash 'StakePool)
[KeyHash 'StakePool] -> Set (KeyHash 'StakePool)
forall l. IsList l => [Item l] -> l
fromList ([KeyHash 'StakePool] -> Set (KeyHash 'StakePool))
-> RIO e [KeyHash 'StakePool] -> RIO e (Set (KeyHash 'StakePool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SPOHashSource -> RIO e (KeyHash 'StakePool))
-> [SPOHashSource] -> RIO e [KeyHash 'StakePool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SPOHashSource -> RIO e (KeyHash 'StakePool)
SPOHashSource -> CIO e (KeyHash 'StakePool)
forall e. SPOHashSource -> CIO e (KeyHash 'StakePool)
spoFromSource [SPOHashSource]
spoHashSources

    let beo :: BabbageEraOnwards era
beo = ConwayEraOnwards era -> BabbageEraOnwards era
forall era. ConwayEraOnwards era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
eon

    Map (KeyHash 'StakePool) Lovelace
spoStakeDistribution :: Map (L.KeyHash L.StakePool) L.Coin <-
      ExceptT QueryCmdError IO (Map (KeyHash 'StakePool) Lovelace)
-> RIO e (Map (KeyHash 'StakePool) Lovelace)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (Map (KeyHash 'StakePool) Lovelace)
 -> RIO e (Map (KeyHash 'StakePool) Lovelace))
-> ExceptT QueryCmdError IO (Map (KeyHash 'StakePool) Lovelace)
-> RIO e (Map (KeyHash 'StakePool) Lovelace)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (KeyHash 'StakePool) Lovelace)))
-> ExceptT QueryCmdError IO (Map (KeyHash 'StakePool) Lovelace)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Map (KeyHash 'StakePool) Lovelace)))
 -> ExceptT QueryCmdError IO (Map (KeyHash 'StakePool) Lovelace))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (KeyHash 'StakePool) Lovelace)))
-> ExceptT QueryCmdError IO (Map (KeyHash 'StakePool) Lovelace)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set (KeyHash 'StakePool)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (KeyHash 'StakePool) Lovelace)))
forall era block point r.
ConwayEraOnwards era
-> Set (KeyHash 'StakePool)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (KeyHash 'StakePool) Lovelace)))
querySPOStakeDistribution ConwayEraOnwards era
eon Set (KeyHash 'StakePool)
spos

    let Set PoolId
poolIds :: Set (Hash StakePoolKey) = [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList ([PoolId] -> Set PoolId) -> [PoolId] -> Set PoolId
forall a b. (a -> b) -> a -> b
$ (KeyHash 'StakePool -> PoolId) -> [KeyHash 'StakePool] -> [PoolId]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'StakePool -> PoolId
StakePoolKeyHash ([KeyHash 'StakePool] -> [PoolId])
-> [KeyHash 'StakePool] -> [PoolId]
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'StakePool) Lovelace -> [KeyHash 'StakePool]
forall k a. Map k a -> [k]
Map.keys Map (KeyHash 'StakePool) Lovelace
spoStakeDistribution

    SerialisedPoolState
serialisedPoolState <-
      ExceptT QueryCmdError IO SerialisedPoolState
-> RIO e SerialisedPoolState
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO SerialisedPoolState
 -> RIO e SerialisedPoolState)
-> ExceptT QueryCmdError IO SerialisedPoolState
-> RIO e SerialisedPoolState
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch SerialisedPoolState))
-> ExceptT QueryCmdError IO SerialisedPoolState
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch SerialisedPoolState))
 -> ExceptT QueryCmdError IO SerialisedPoolState)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch SerialisedPoolState))
-> ExceptT QueryCmdError IO SerialisedPoolState
forall a b. (a -> b) -> a -> b
$ BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch SerialisedPoolState))
forall era block point r.
BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch SerialisedPoolState))
queryPoolState BabbageEraOnwards era
beo (Set PoolId -> Maybe (Set PoolId)
forall a. a -> Maybe a
Just Set PoolId
poolIds)

    PoolState QueryPoolStateResult
poolStateResult <-
      Either DecoderError (PoolState era) -> RIO e (PoolState era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either DecoderError (PoolState era) -> RIO e (PoolState era))
-> Either DecoderError (PoolState era) -> RIO e (PoolState era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> SerialisedPoolState -> Either DecoderError (PoolState era)
forall era.
ShelleyBasedEra era
-> SerialisedPoolState -> Either DecoderError (PoolState era)
decodePoolState (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
eon) SerialisedPoolState
serialisedPoolState

    let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential 'L.Staking)
        spoToRewardCred :: Map (KeyHash 'StakePool) StakeCredential
spoToRewardCred =
          (PoolParams -> StakeCredential)
-> Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) StakeCredential
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
            (RewardAccount -> StakeCredential
L.raCredential (RewardAccount -> StakeCredential)
-> (PoolParams -> RewardAccount) -> PoolParams -> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> RewardAccount
L.ppRewardAccount)
            (QueryPoolStateResult -> Map (KeyHash 'StakePool) PoolParams
L.qpsrStakePoolParams QueryPoolStateResult
poolStateResult)

        allRewardCreds :: Set StakeCredential
        allRewardCreds :: Set StakeCredential
allRewardCreds = [StakeCredential] -> Set StakeCredential
forall a. Ord a => [a] -> Set a
Set.fromList ([StakeCredential] -> Set StakeCredential)
-> [StakeCredential] -> Set StakeCredential
forall a b. (a -> b) -> a -> b
$ (StakeCredential -> StakeCredential)
-> [StakeCredential] -> [StakeCredential]
forall a b. (a -> b) -> [a] -> [b]
map StakeCredential -> StakeCredential
fromShelleyStakeCredential ([StakeCredential] -> [StakeCredential])
-> [StakeCredential] -> [StakeCredential]
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'StakePool) StakeCredential -> [StakeCredential]
forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'StakePool) StakeCredential
spoToRewardCred

    Map StakeCredential DRep
rewardCredToDRep <-
      ExceptT QueryCmdError IO (Map StakeCredential DRep)
-> RIO e (Map StakeCredential DRep)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO (Map StakeCredential DRep)
 -> RIO e (Map StakeCredential DRep))
-> ExceptT QueryCmdError IO (Map StakeCredential DRep)
-> RIO e (Map StakeCredential DRep)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
-> ExceptT QueryCmdError IO (Map StakeCredential DRep)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Map StakeCredential DRep)))
 -> ExceptT QueryCmdError IO (Map StakeCredential DRep))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
-> ExceptT QueryCmdError IO (Map StakeCredential DRep)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
forall era block point r.
ConwayEraOnwards era
-> Set StakeCredential
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map StakeCredential DRep)))
queryStakeVoteDelegatees ConwayEraOnwards era
eon Set StakeCredential
allRewardCreds

    let spoToDelegatee :: Map (L.KeyHash L.StakePool) L.DRep
        spoToDelegatee :: Map (KeyHash 'StakePool) DRep
spoToDelegatee =
          (StakeCredential -> Maybe DRep)
-> Map (KeyHash 'StakePool) StakeCredential
-> Map (KeyHash 'StakePool) DRep
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe
            (\StakeCredential
rewardCred -> StakeCredential -> Map StakeCredential DRep -> Maybe DRep
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (StakeCredential -> StakeCredential
fromShelleyStakeCredential StakeCredential
rewardCred) Map StakeCredential DRep
rewardCredToDRep)
            Map (KeyHash 'StakePool) StakeCredential
spoToRewardCred

    let json :: [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
json =
          [ ( KeyHash 'StakePool
spo
            , Lovelace
coin
            , KeyHash 'StakePool -> Map (KeyHash 'StakePool) DRep -> Maybe DRep
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
spo Map (KeyHash 'StakePool) DRep
spoToDelegatee
            )
          | (KeyHash 'StakePool
spo, Lovelace
coin) <- Map (KeyHash 'StakePool) Lovelace
-> [(KeyHash 'StakePool, Lovelace)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map (KeyHash 'StakePool) Lovelace
spoStakeDistribution
          ]

        output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
 -> ByteString)
-> ((Vary '[]
     -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
    -> ByteString)
-> (Vary '[]
    -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson
 -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> (Vary '[FormatYaml]
    -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml]
  -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
 -> ByteString)
-> ((Vary '[]
     -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
    -> Vary '[FormatYaml]
    -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
    -> ByteString)
-> (Vary '[]
    -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml
 -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> (Vary '[]
    -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> Vary '[FormatYaml]
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[]
  -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
 -> ByteString)
-> (Vary '[]
    -> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[]
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            ([(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString)
-> [(KeyHash 'StakePool, Lovelace, Maybe DRep)] -> ByteString
forall a b. (a -> b) -> a -> b
$ [(KeyHash 'StakePool, Lovelace, Maybe DRep)]
json

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryCommitteeMembersState
  :: Cmd.QueryCommitteeMembersStateCmdArgs era
  -> CIO e ()
runQueryCommitteeMembersState :: forall era e. QueryCommitteeMembersStateCmdArgs era -> CIO e ()
runQueryCommitteeMembersState
  Cmd.QueryCommitteeMembersStateCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
QueryCommitteeMembersStateCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryCommitteeMembersStateCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , committeeColdKeys :: forall era.
QueryCommitteeMembersStateCmdArgs era
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
Cmd.committeeColdKeys = [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
coldCredKeys
    , committeeHotKeys :: forall era.
QueryCommitteeMembersStateCmdArgs era
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey]
Cmd.committeeHotKeys = [VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey]
hotCredKeys
    , memberStatuses :: forall era. QueryCommitteeMembersStateCmdArgs era -> [MemberStatus]
Cmd.memberStatuses = [MemberStatus]
memberStatuses
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: forall era.
QueryCommitteeMembersStateCmdArgs era
-> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era.
QueryCommitteeMembersStateCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    let coldKeysFromVerKeyHashOrFile :: VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> CIO e (Credential 'ColdCommitteeRole)
coldKeysFromVerKeyHashOrFile =
          (Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> CIO e (Credential 'ColdCommitteeRole)
forall keyrole (kr :: KeyRole) e.
Key keyrole =>
(Hash keyrole -> KeyHash kr)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> CIO e (Credential kr)
readVerificationKeyOrHashOrFileOrScriptHash Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole
unCommitteeColdKeyHash
    Set (Credential 'ColdCommitteeRole)
coldKeys <- [Item (Set (Credential 'ColdCommitteeRole))]
-> Set (Credential 'ColdCommitteeRole)
[Credential 'ColdCommitteeRole]
-> Set (Credential 'ColdCommitteeRole)
forall l. IsList l => [Item l] -> l
fromList ([Credential 'ColdCommitteeRole]
 -> Set (Credential 'ColdCommitteeRole))
-> RIO e [Credential 'ColdCommitteeRole]
-> RIO e (Set (Credential 'ColdCommitteeRole))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
 -> RIO e (Credential 'ColdCommitteeRole))
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
-> RIO e [Credential 'ColdCommitteeRole]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> RIO e (Credential 'ColdCommitteeRole)
VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> CIO e (Credential 'ColdCommitteeRole)
forall {e}.
VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> CIO e (Credential 'ColdCommitteeRole)
coldKeysFromVerKeyHashOrFile [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
coldCredKeys

    let hotKeysFromVerKeyHashOrFile :: VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> CIO e (Credential 'HotCommitteeRole)
hotKeysFromVerKeyHashOrFile =
          (Hash CommitteeHotKey -> KeyHash 'HotCommitteeRole)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> CIO e (Credential 'HotCommitteeRole)
forall keyrole (kr :: KeyRole) e.
Key keyrole =>
(Hash keyrole -> KeyHash kr)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> CIO e (Credential kr)
readVerificationKeyOrHashOrFileOrScriptHash Hash CommitteeHotKey -> KeyHash 'HotCommitteeRole
unCommitteeHotKeyHash
    Set (Credential 'HotCommitteeRole)
hotKeys <- [Item (Set (Credential 'HotCommitteeRole))]
-> Set (Credential 'HotCommitteeRole)
[Credential 'HotCommitteeRole]
-> Set (Credential 'HotCommitteeRole)
forall l. IsList l => [Item l] -> l
fromList ([Credential 'HotCommitteeRole]
 -> Set (Credential 'HotCommitteeRole))
-> RIO e [Credential 'HotCommitteeRole]
-> RIO e (Set (Credential 'HotCommitteeRole))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
 -> RIO e (Credential 'HotCommitteeRole))
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey]
-> RIO e [Credential 'HotCommitteeRole]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> RIO e (Credential 'HotCommitteeRole)
VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> CIO e (Credential 'HotCommitteeRole)
forall {e}.
VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> CIO e (Credential 'HotCommitteeRole)
hotKeysFromVerKeyHashOrFile [VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey]
hotCredKeys

    CommitteeMembersState
committeeState <-
      ExceptT QueryCmdError IO CommitteeMembersState
-> RIO e CommitteeMembersState
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO CommitteeMembersState
 -> RIO e CommitteeMembersState)
-> ExceptT QueryCmdError IO CommitteeMembersState
-> RIO e CommitteeMembersState
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch CommitteeMembersState))
-> ExceptT QueryCmdError IO CommitteeMembersState
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch CommitteeMembersState))
 -> ExceptT QueryCmdError IO CommitteeMembersState)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch CommitteeMembersState))
-> ExceptT QueryCmdError IO CommitteeMembersState
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch CommitteeMembersState))
forall era block point r.
ConwayEraOnwards era
-> Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch CommitteeMembersState))
queryCommitteeMembersState ConwayEraOnwards era
eon Set (Credential 'ColdCommitteeRole)
coldKeys Set (Credential 'HotCommitteeRole)
hotKeys ([Item (Set MemberStatus)] -> Set MemberStatus
forall l. IsList l => [Item l] -> l
fromList [Item (Set MemberStatus)]
[MemberStatus]
memberStatuses)

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> CommitteeMembersState -> ByteString)
-> CommitteeMembersState
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> CommitteeMembersState -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> CommitteeMembersState
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> CommitteeMembersState -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> CommitteeMembersState
 -> ByteString)
-> ((Vary '[] -> CommitteeMembersState -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> CommitteeMembersState
    -> ByteString)
-> (Vary '[] -> CommitteeMembersState -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> CommitteeMembersState
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> CommitteeMembersState -> ByteString)
-> (Vary '[FormatYaml] -> CommitteeMembersState -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> CommitteeMembersState
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> CommitteeMembersState -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml] -> CommitteeMembersState -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> CommitteeMembersState
 -> ByteString)
-> ((Vary '[] -> CommitteeMembersState -> ByteString)
    -> Vary '[FormatYaml] -> CommitteeMembersState -> ByteString)
-> (Vary '[] -> CommitteeMembersState -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> CommitteeMembersState
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> CommitteeMembersState -> ByteString)
-> (Vary '[] -> CommitteeMembersState -> ByteString)
-> Vary '[FormatYaml]
-> CommitteeMembersState
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> CommitteeMembersState -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> CommitteeMembersState -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> CommitteeMembersState
 -> ByteString)
-> (Vary '[] -> CommitteeMembersState -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> CommitteeMembersState
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> CommitteeMembersState -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (CommitteeMembersState -> ByteString)
-> CommitteeMembersState -> ByteString
forall a b. (a -> b) -> a -> b
$ CommitteeMembersState
committeeState

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryTreasuryValue
  :: Cmd.QueryTreasuryValueCmdArgs era
  -> CIO e ()
runQueryTreasuryValue :: forall era e. QueryTreasuryValueCmdArgs era -> CIO e ()
runQueryTreasuryValue
  Cmd.QueryTreasuryValueCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. QueryTreasuryValueCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryTreasuryValueCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. QueryTreasuryValueCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    ChainAccountState
chainAccountState <-
      ExceptT QueryCmdError IO ChainAccountState
-> RIO e ChainAccountState
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO ChainAccountState
 -> RIO e ChainAccountState)
-> ExceptT QueryCmdError IO ChainAccountState
-> RIO e ChainAccountState
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch ChainAccountState))
-> ExceptT QueryCmdError IO ChainAccountState
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError (Either EraMismatch ChainAccountState))
 -> ExceptT QueryCmdError IO ChainAccountState)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch ChainAccountState))
-> ExceptT QueryCmdError IO ChainAccountState
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch ChainAccountState))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch ChainAccountState))
queryAccountState ConwayEraOnwards era
eon

    let (L.Coin Integer
treasury) = ChainAccountState -> Lovelace
casTreasury ChainAccountState
chainAccountState
        output :: ByteString
output = FilePath -> ByteString
LBS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
treasury

    forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli @(FileError ()) (CIO e (Either (FileError ()) ()) -> CIO e ())
-> CIO e (Either (FileError ()) ()) -> CIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out)
-> ByteString -> RIO e (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryProposals
  :: Cmd.QueryProposalsCmdArgs era
  -> CIO e ()
runQueryProposals :: forall era e. QueryProposalsCmdArgs era -> CIO e ()
runQueryProposals
  Cmd.QueryProposalsCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. QueryProposalsCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryProposalsCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , govActionIds :: forall era. QueryProposalsCmdArgs era -> AllOrOnly GovActionId
Cmd.govActionIds = AllOrOnly GovActionId
govActionIds'
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: forall era.
QueryProposalsCmdArgs era -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. QueryProposalsCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    let govActionIds :: [GovActionId]
govActionIds = case AllOrOnly GovActionId
govActionIds' of
          AllOrOnly GovActionId
All -> []
          Only [GovActionId]
l -> [GovActionId]
l

    Seq (GovActionState (ShelleyLedgerEra era))
govActionStates :: (Seq.Seq (L.GovActionState (ShelleyLedgerEra era))) <-
      ExceptT
  QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era)))
-> RIO e (Seq (GovActionState (ShelleyLedgerEra era)))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT
   QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era)))
 -> RIO e (Seq (GovActionState (ShelleyLedgerEra era))))
-> ExceptT
     QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era)))
-> RIO e (Seq (GovActionState (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
-> ExceptT
     QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era)))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
 -> ExceptT
      QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
-> ExceptT
     QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set GovActionId
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
forall era block point r.
ConwayEraOnwards era
-> Set GovActionId
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
queryProposals ConwayEraOnwards era
eon (Set GovActionId
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either
         UnsupportedNtcVersionError
         (Either
            EraMismatch (Seq (GovActionState (ShelleyLedgerEra era))))))
-> Set GovActionId
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
forall a b. (a -> b) -> a -> b
$ [GovActionId] -> Set GovActionId
forall a. Ord a => [a] -> Set a
Set.fromList [GovActionId]
govActionIds

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml]
    -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> Seq (GovActionState (ShelleyLedgerEra era))
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml]
 -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Seq (GovActionState (ShelleyLedgerEra era))
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml]
  -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Seq (GovActionState (ShelleyLedgerEra era))
 -> ByteString)
-> ((Vary '[]
     -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
    -> Vary '[FormatJson, FormatYaml]
    -> Seq (GovActionState (ShelleyLedgerEra era))
    -> ByteString)
-> (Vary '[]
    -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Seq (GovActionState (ShelleyLedgerEra era))
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson
 -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> (Vary '[FormatYaml]
    -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Seq (GovActionState (ShelleyLedgerEra era))
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml]
  -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Seq (GovActionState (ShelleyLedgerEra era))
 -> ByteString)
-> ((Vary '[]
     -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
    -> Vary '[FormatYaml]
    -> Seq (GovActionState (ShelleyLedgerEra era))
    -> ByteString)
-> (Vary '[]
    -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Seq (GovActionState (ShelleyLedgerEra era))
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml
 -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> (Vary '[]
    -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatYaml]
-> Seq (GovActionState (ShelleyLedgerEra era))
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[]
  -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
 -> Vary '[FormatJson, FormatYaml]
 -> Seq (GovActionState (ShelleyLedgerEra era))
 -> ByteString)
-> (Vary '[]
    -> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> Seq (GovActionState (ShelleyLedgerEra era))
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[]
-> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString)
-> Seq (GovActionState (ShelleyLedgerEra era)) -> ByteString
forall a b. (a -> b) -> a -> b
$ Seq (GovActionState (ShelleyLedgerEra era))
govActionStates

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryEraHistoryCmd :: Cmd.QueryEraHistoryCmdArgs -> CIO e ()
runQueryEraHistoryCmd :: forall e. QueryEraHistoryCmdArgs -> CIO e ()
runQueryEraHistoryCmd
  Cmd.QueryEraHistoryCmdArgs
    { commons :: QueryEraHistoryCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryEraHistoryCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    EraHistory
eraHistory <-
      IO (Either AcquiringFailure (Either QueryCmdError EraHistory))
-> RIO e (Either QueryCmdError EraHistory)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError EraHistory)
-> IO (Either AcquiringFailure (Either QueryCmdError EraHistory))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError EraHistory)
 -> IO (Either AcquiringFailure (Either QueryCmdError EraHistory)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError EraHistory)
-> IO (Either AcquiringFailure (Either QueryCmdError EraHistory))
forall a b. (a -> b) -> a -> b
$
            ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  EraHistory
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError EraHistory)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   EraHistory
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError EraHistory))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError EraHistory)
forall a b. (a -> b) -> a -> b
$
              LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError EraHistory)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError EraHistory)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError EraHistory)
queryEraHistory ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError EraHistory)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError EraHistory)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      EraHistory)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)
        )
        RIO e (Either QueryCmdError EraHistory)
-> (RIO e (Either QueryCmdError EraHistory) -> RIO e EraHistory)
-> RIO e EraHistory
forall a b. a -> (a -> b) -> b
& RIO e (Either QueryCmdError EraHistory) -> RIO e EraHistory
CIO e (Either QueryCmdError EraHistory) -> CIO e EraHistory
forall err e a.
(Show err, Typeable err, Error err) =>
CIO e (Either err a) -> CIO e a
fromEitherCIOCli

    let output :: ByteString
output = Maybe TextEnvelopeDescr -> EraHistory -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing EraHistory
eraHistory

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQueryStakePoolDefaultVote
  :: Cmd.QueryStakePoolDefaultVoteCmdArgs era
  -> CIO e ()
runQueryStakePoolDefaultVote :: forall era e. QueryStakePoolDefaultVoteCmdArgs era -> CIO e ()
runQueryStakePoolDefaultVote
  Cmd.QueryStakePoolDefaultVoteCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
QueryStakePoolDefaultVoteCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryStakePoolDefaultVoteCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { LocalNodeConnectInfo
nodeConnInfo :: QueryCommons -> LocalNodeConnectInfo
nodeConnInfo :: LocalNodeConnectInfo
Cmd.nodeConnInfo
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , SPOHashSource
spoHashSources :: SPOHashSource
spoHashSources :: forall era. QueryStakePoolDefaultVoteCmdArgs era -> SPOHashSource
Cmd.spoHashSources
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: forall era.
QueryStakePoolDefaultVoteCmdArgs era
-> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era.
QueryStakePoolDefaultVoteCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ())
-> (ConwayEraOnwardsConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    let spoFromSource :: SPOHashSource -> CIO e (KeyHash 'StakePool)
spoFromSource = SPOHashSource -> CIO e (KeyHash 'StakePool)
forall e. SPOHashSource -> CIO e (KeyHash 'StakePool)
readSPOCredential
    KeyHash 'StakePool
spo <- SPOHashSource -> CIO e (KeyHash 'StakePool)
forall e. SPOHashSource -> CIO e (KeyHash 'StakePool)
spoFromSource SPOHashSource
spoHashSources

    DefaultVote
defVote :: L.DefaultVote <-
      ExceptT QueryCmdError IO DefaultVote -> RIO e DefaultVote
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT QueryCmdError IO DefaultVote -> RIO e DefaultVote)
-> ExceptT QueryCmdError IO DefaultVote -> RIO e DefaultVote
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch DefaultVote))
-> ExceptT QueryCmdError IO DefaultVote
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
nodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError (Either EraMismatch DefaultVote))
 -> ExceptT QueryCmdError IO DefaultVote)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch DefaultVote))
-> ExceptT QueryCmdError IO DefaultVote
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> KeyHash 'StakePool
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch DefaultVote))
forall era block point r.
ConwayEraOnwards era
-> KeyHash 'StakePool
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch DefaultVote))
queryStakePoolDefaultVote ConwayEraOnwards era
eon KeyHash 'StakePool
spo

    let output :: ByteString
output =
          Vary '[FormatJson, FormatYaml]
outputFormat
            Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml] -> DefaultVote -> ByteString)
-> DefaultVote
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml] -> DefaultVote -> ByteString)
-> Vary '[FormatJson, FormatYaml] -> DefaultVote -> ByteString
forall a. a -> a
id
                  ((Vary '[FormatJson, FormatYaml] -> DefaultVote -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> DefaultVote -> ByteString)
-> ((Vary '[] -> DefaultVote -> ByteString)
    -> Vary '[FormatJson, FormatYaml] -> DefaultVote -> ByteString)
-> (Vary '[] -> DefaultVote -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> DefaultVote
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> DefaultVote -> ByteString)
-> (Vary '[FormatYaml] -> DefaultVote -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> DefaultVote
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> DefaultVote -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                  ((Vary '[FormatYaml] -> DefaultVote -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> DefaultVote -> ByteString)
-> ((Vary '[] -> DefaultVote -> ByteString)
    -> Vary '[FormatYaml] -> DefaultVote -> ByteString)
-> (Vary '[] -> DefaultVote -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> DefaultVote
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> DefaultVote -> ByteString)
-> (Vary '[] -> DefaultVote -> ByteString)
-> Vary '[FormatYaml]
-> DefaultVote
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> DefaultVote -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                  ((Vary '[] -> DefaultVote -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> DefaultVote -> ByteString)
-> (Vary '[] -> DefaultVote -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> DefaultVote
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> DefaultVote -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (DefaultVote -> ByteString) -> DefaultVote -> ByteString
forall a b. (a -> b) -> a -> b
$ DefaultVote
defVote

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runQuery
  :: LocalNodeConnectInfo
  -> Consensus.Target ChainPoint
  -> LocalStateQueryExpr
       BlockInMode
       ChainPoint
       QueryInMode
       ()
       IO
       ( Either
           UnsupportedNtcVersionError
           (Either Consensus.EraMismatch a)
       )
  -> ExceptT QueryCmdError IO a
runQuery :: forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (Either EraMismatch a))
query =
  (AcquiringFailure -> QueryCmdError)
-> ExceptT
     AcquiringFailure
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT
     QueryCmdError
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT
    AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure
    (IO
  (Either
     AcquiringFailure
     (Either UnsupportedNtcVersionError (Either EraMismatch a)))
-> ExceptT
     AcquiringFailure
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquiringFailure
      (Either UnsupportedNtcVersionError (Either EraMismatch a)))
 -> ExceptT
      AcquiringFailure
      IO
      (Either UnsupportedNtcVersionError (Either EraMismatch a)))
-> IO
     (Either
        AcquiringFailure
        (Either UnsupportedNtcVersionError (Either EraMismatch a)))
-> ExceptT
     AcquiringFailure
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> IO
     (Either
        AcquiringFailure
        (Either UnsupportedNtcVersionError (Either EraMismatch a)))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (Either EraMismatch a))
query)
    ExceptT
  QueryCmdError
  IO
  (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> (ExceptT
      QueryCmdError
      IO
      (Either UnsupportedNtcVersionError (Either EraMismatch a))
    -> ExceptT QueryCmdError IO (Either EraMismatch a))
-> ExceptT QueryCmdError IO (Either EraMismatch a)
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT QueryCmdError IO (Either EraMismatch a))
-> ExceptT
     QueryCmdError
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO (Either EraMismatch a)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError IO (Either EraMismatch a)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO (Either EraMismatch a))
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT QueryCmdError IO (Either EraMismatch a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)
    ExceptT QueryCmdError IO (Either EraMismatch a)
-> (ExceptT QueryCmdError IO (Either EraMismatch a)
    -> ExceptT QueryCmdError IO a)
-> ExceptT QueryCmdError IO a
forall a b. a -> (a -> b) -> b
& (EraMismatch -> ExceptT QueryCmdError IO a)
-> ExceptT QueryCmdError IO (Either EraMismatch a)
-> ExceptT QueryCmdError IO a
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO a)
-> (EraMismatch -> QueryCmdError)
-> EraMismatch
-> ExceptT QueryCmdError IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryCmdError
QueryCmdEraMismatch)

-- Helpers

toEpochInfo :: EraHistory -> EpochInfo (Either Text)
toEpochInfo :: EraHistory -> EpochInfo (Either Text)
toEpochInfo (EraHistory Interpreter xs
interpreter) =
  (forall a. Except PastHorizonException a -> Either Text a)
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo ((PastHorizonException -> Text)
-> Either PastHorizonException a -> Either Text a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> Text
Text.pack (FilePath -> Text)
-> (PastHorizonException -> FilePath)
-> PastHorizonException
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PastHorizonException -> FilePath
forall a. Show a => a -> FilePath
show) (Either PastHorizonException a -> Either Text a)
-> (Except PastHorizonException a -> Either PastHorizonException a)
-> Except PastHorizonException a
-> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except PastHorizonException a -> Either PastHorizonException a
forall e a. Except e a -> Either e a
runExcept) (EpochInfo (Except PastHorizonException)
 -> EpochInfo (Either Text))
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall a b. (a -> b) -> a -> b
$
    Interpreter xs -> EpochInfo (Except PastHorizonException)
forall (xs :: [*]).
Interpreter xs -> EpochInfo (Except PastHorizonException)
Consensus.interpreterToEpochInfo Interpreter xs
interpreter

-- | A value that is tentative or produces a tentative value if used.  These values
-- are considered accurate only if some future event such as a hard fork does not
-- render them invalid.
newtype Tentative a = Tentative {forall a. Tentative a -> a
tentative :: a} deriving (Tentative a -> Tentative a -> Bool
(Tentative a -> Tentative a -> Bool)
-> (Tentative a -> Tentative a -> Bool) -> Eq (Tentative a)
forall a. Eq a => Tentative a -> Tentative a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Tentative a -> Tentative a -> Bool
== :: Tentative a -> Tentative a -> Bool
$c/= :: forall a. Eq a => Tentative a -> Tentative a -> Bool
/= :: Tentative a -> Tentative a -> Bool
Eq, Int -> Tentative a -> FilePath -> FilePath
[Tentative a] -> FilePath -> FilePath
Tentative a -> FilePath
(Int -> Tentative a -> FilePath -> FilePath)
-> (Tentative a -> FilePath)
-> ([Tentative a] -> FilePath -> FilePath)
-> Show (Tentative a)
forall a. Show a => Int -> Tentative a -> FilePath -> FilePath
forall a. Show a => [Tentative a] -> FilePath -> FilePath
forall a. Show a => Tentative a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Tentative a -> FilePath -> FilePath
showsPrec :: Int -> Tentative a -> FilePath -> FilePath
$cshow :: forall a. Show a => Tentative a -> FilePath
show :: Tentative a -> FilePath
$cshowList :: forall a. Show a => [Tentative a] -> FilePath -> FilePath
showList :: [Tentative a] -> FilePath -> FilePath
Show)

-- | Get an Epoch Info that computes tentative values.  The values computed are
-- tentative because it uses an interpreter that is extended past the horizon.
-- This interpreter will compute accurate values into the future as long as a
-- a hard fork does not happen in the intervening time.  Those values are thus
-- "tentative" because they can change in the event of a hard fork.
toTentativeEpochInfo :: EraHistory -> Tentative (EpochInfo (Either Text))
toTentativeEpochInfo :: EraHistory -> Tentative (EpochInfo (Either Text))
toTentativeEpochInfo (EraHistory Interpreter xs
interpreter) =
  EpochInfo (Either Text) -> Tentative (EpochInfo (Either Text))
forall a. a -> Tentative a
Tentative (EpochInfo (Either Text) -> Tentative (EpochInfo (Either Text)))
-> EpochInfo (Either Text) -> Tentative (EpochInfo (Either Text))
forall a b. (a -> b) -> a -> b
$
    (forall a. Except PastHorizonException a -> Either Text a)
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo ((PastHorizonException -> Text)
-> Either PastHorizonException a -> Either Text a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> Text
Text.pack (FilePath -> Text)
-> (PastHorizonException -> FilePath)
-> PastHorizonException
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PastHorizonException -> FilePath
forall a. Show a => a -> FilePath
show) (Either PastHorizonException a -> Either Text a)
-> (Except PastHorizonException a -> Either PastHorizonException a)
-> Except PastHorizonException a
-> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except PastHorizonException a -> Either PastHorizonException a
forall e a. Except e a -> Either e a
runExcept) (EpochInfo (Except PastHorizonException)
 -> EpochInfo (Either Text))
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall a b. (a -> b) -> a -> b
$
      Interpreter xs -> EpochInfo (Except PastHorizonException)
forall (xs :: [*]).
Interpreter xs -> EpochInfo (Except PastHorizonException)
Consensus.interpreterToEpochInfo (Interpreter xs -> Interpreter xs
forall (xs :: [*]). Interpreter xs -> Interpreter xs
Consensus.unsafeExtendSafeZone Interpreter xs
interpreter)

-- | Get slot number for timestamp, or an error if the UTC timestamp is before 'SystemStart' or after N+1 era
utcTimeToSlotNo
  :: LocalNodeConnectInfo
  -> Consensus.Target ChainPoint
  -> UTCTime
  -> ExceptT QueryCmdError IO SlotNo
utcTimeToSlotNo :: LocalNodeConnectInfo
-> Target ChainPoint -> UTCTime -> ExceptT QueryCmdError IO SlotNo
utcTimeToSlotNo LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target UTCTime
utcTime =
  IO (Either AcquiringFailure (Either QueryCmdError SlotNo))
-> ExceptT
     QueryCmdError
     IO
     (Either AcquiringFailure (Either QueryCmdError SlotNo))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
    ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError SlotNo)
-> IO (Either AcquiringFailure (Either QueryCmdError SlotNo))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError SlotNo)
 -> IO (Either AcquiringFailure (Either QueryCmdError SlotNo)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError SlotNo)
-> IO (Either AcquiringFailure (Either QueryCmdError SlotNo))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  SlotNo
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError SlotNo)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   SlotNo
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError SlotNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SlotNo
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError SlotNo)
forall a b. (a -> b) -> a -> b
$ do
        SystemStart
systemStart <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  SystemStart
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  SystemStart
easyRunQuerySystemStart
        EraHistory
eraHistory <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  EraHistory
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  EraHistory
easyRunQueryEraHistory

        let relTime :: RelativeTime
relTime = SystemStart -> UTCTime -> RelativeTime
toRelativeTime SystemStart
systemStart UTCTime
utcTime

        Either PastHorizonException SlotNo
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either PastHorizonException SlotNo)
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelativeTime -> EraHistory -> Either PastHorizonException SlotNo
Api.getSlotForRelativeTime RelativeTime
relTime EraHistory
eraHistory)
          ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either PastHorizonException SlotNo)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either PastHorizonException SlotNo)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         SlotNo)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SlotNo
forall a b. a -> (a -> b) -> b
& (PastHorizonException
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      SlotNo)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either PastHorizonException SlotNo)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SlotNo
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SlotNo
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      SlotNo)
-> (PastHorizonException -> QueryCmdError)
-> PastHorizonException
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PastHorizonException -> QueryCmdError
QueryCmdPastHorizon)
    )
    ExceptT
  QueryCmdError
  IO
  (Either AcquiringFailure (Either QueryCmdError SlotNo))
-> (ExceptT
      QueryCmdError
      IO
      (Either AcquiringFailure (Either QueryCmdError SlotNo))
    -> ExceptT QueryCmdError IO (Either QueryCmdError SlotNo))
-> ExceptT QueryCmdError IO (Either QueryCmdError SlotNo)
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT QueryCmdError IO (Either QueryCmdError SlotNo))
-> ExceptT
     QueryCmdError
     IO
     (Either AcquiringFailure (Either QueryCmdError SlotNo))
-> ExceptT QueryCmdError IO (Either QueryCmdError SlotNo)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT QueryCmdError IO (Either QueryCmdError SlotNo)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT QueryCmdError IO (Either QueryCmdError SlotNo))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT QueryCmdError IO (Either QueryCmdError SlotNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
    ExceptT QueryCmdError IO (Either QueryCmdError SlotNo)
-> (ExceptT QueryCmdError IO (Either QueryCmdError SlotNo)
    -> ExceptT QueryCmdError IO SlotNo)
-> ExceptT QueryCmdError IO SlotNo
forall a b. a -> (a -> b) -> b
& (QueryCmdError -> ExceptT QueryCmdError IO SlotNo)
-> ExceptT QueryCmdError IO (Either QueryCmdError SlotNo)
-> ExceptT QueryCmdError IO SlotNo
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError -> ExceptT QueryCmdError IO SlotNo
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

strictTextToLazyBytestring :: Text -> LBS.ByteString
strictTextToLazyBytestring :: Text -> ByteString
strictTextToLazyBytestring Text
t = [ByteString] -> ByteString
BS.fromChunks [Text -> ByteString
Text.encodeUtf8 Text
t]

easyRunQueryCurrentEra
  :: ExceptT QueryCmdError (LocalStateQueryExpr block point QueryInMode r IO) AnyCardanoEra
easyRunQueryCurrentEra :: forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra = LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either UnsupportedNtcVersionError AnyCardanoEra)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr block point QueryInMode r IO)
      (Either UnsupportedNtcVersionError AnyCardanoEra)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr block point QueryInMode r IO)
         AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr block point QueryInMode r IO)
     AnyCardanoEra
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr block point QueryInMode r IO)
      AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr block point QueryInMode r IO)
     (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr block point QueryInMode r IO)
     AnyCardanoEra
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr block point QueryInMode r IO)
     AnyCardanoEra
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr block point QueryInMode r IO)
      AnyCardanoEra)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr block point QueryInMode r IO)
     AnyCardanoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)

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

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

easyRunQuery
  :: ()
  => Monad m
  => m (Either UnsupportedNtcVersionError (Either Consensus.EraMismatch a))
  -> ExceptT QueryCmdError m a
easyRunQuery :: forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery m (Either UnsupportedNtcVersionError (Either EraMismatch a))
q =
  m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT
     QueryCmdError
     m
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Either UnsupportedNtcVersionError (Either EraMismatch a))
q
    ExceptT
  QueryCmdError
  m
  (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> (ExceptT
      QueryCmdError
      m
      (Either UnsupportedNtcVersionError (Either EraMismatch a))
    -> ExceptT QueryCmdError m (Either EraMismatch a))
-> ExceptT QueryCmdError m (Either EraMismatch a)
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT QueryCmdError m (Either EraMismatch a))
-> ExceptT
     QueryCmdError
     m
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m (Either EraMismatch a)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError m (Either EraMismatch a)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError m (Either EraMismatch a))
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT QueryCmdError m (Either EraMismatch a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)
    ExceptT QueryCmdError m (Either EraMismatch a)
-> (ExceptT QueryCmdError m (Either EraMismatch a)
    -> ExceptT QueryCmdError m a)
-> ExceptT QueryCmdError m a
forall a b. a -> (a -> b) -> b
& (EraMismatch -> ExceptT QueryCmdError m a)
-> ExceptT QueryCmdError m (Either EraMismatch a)
-> ExceptT QueryCmdError m a
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError m a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError m a)
-> (EraMismatch -> QueryCmdError)
-> EraMismatch
-> ExceptT QueryCmdError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraMismatch -> QueryCmdError
QueryCmdEraMismatch)

supportedEra :: Typeable era => CardanoEra era -> ExceptT QueryCmdError IO (Exp.Era era)
supportedEra :: forall era.
Typeable era =>
CardanoEra era -> ExceptT QueryCmdError IO (Era era)
supportedEra CardanoEra era
cEra =
  Maybe (Era era) -> ExceptT QueryCmdError IO (Maybe (Era era))
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoEra era -> Maybe (Era era)
forall (eon :: * -> *) era.
Eon eon =>
CardanoEra era -> Maybe (eon era)
forEraMaybeEon CardanoEra era
cEra)
    ExceptT QueryCmdError IO (Maybe (Era era))
-> (ExceptT QueryCmdError IO (Maybe (Era era))
    -> ExceptT QueryCmdError IO (Era era))
-> ExceptT QueryCmdError IO (Era era)
forall a b. a -> (a -> b) -> b
& ExceptT QueryCmdError IO (Era era)
-> ExceptT QueryCmdError IO (Maybe (Era era))
-> ExceptT QueryCmdError IO (Era era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError -> ExceptT QueryCmdError IO (Era era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO (Era era))
-> QueryCmdError -> ExceptT QueryCmdError IO (Era era)
forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> QueryCmdError
QueryCmdEraNotSupported (CardanoEra era -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
cEra))