{-# 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 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 forEraInEonMaybe cEra 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 <-
          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 =
              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

        fromEitherIOCli @(FileError ()) $
          writeLazyByteStringOutput mOutFile 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
    eLocalState <- IO
  (Either
     QueryCmdError
     (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0))))
-> RIO e (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0)))
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 (ZonkAny 0))))
 -> RIO
      e (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0))))
-> IO
     (Either
        QueryCmdError
        (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0))))
-> RIO e (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0)))
forall a b. (a -> b) -> a -> b
$
      (Either
   AcquiringFailure
   (Either QueryCmdError (QueryTipLocalState (ZonkAny 0)))
 -> Either
      QueryCmdError
      (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0))))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (QueryTipLocalState (ZonkAny 0))))
-> IO
     (Either
        QueryCmdError
        (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0))))
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 (ZonkAny 0)))
-> Either
     QueryCmdError
     (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0)))
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 (ZonkAny 0))))
 -> IO
      (Either
         QueryCmdError
         (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0)))))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (QueryTipLocalState (ZonkAny 0))))
-> IO
     (Either
        QueryCmdError
        (Either AcquiringFailure (QueryTipLocalState (ZonkAny 0))))
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState (ZonkAny 0)))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (QueryTipLocalState (ZonkAny 0))))
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 (ZonkAny 0)))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (QueryTipLocalState (ZonkAny 0)))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState (ZonkAny 0)))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (QueryTipLocalState (ZonkAny 0))))
forall a b. (a -> b) -> a -> b
$
          ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (QueryTipLocalState (ZonkAny 0))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState (ZonkAny 0)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (QueryTipLocalState (ZonkAny 0))
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (QueryTipLocalState (ZonkAny 0))))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (QueryTipLocalState (ZonkAny 0))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState (ZonkAny 0)))
forall a b. (a -> b) -> a -> b
$ do
            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 <- lift queryEraHistory & onLeft (left . QueryCmdUnsupportedNtcVersion)
            mChainBlockNo <- lift queryChainBlockNo & onLeft (left . QueryCmdUnsupportedNtcVersion) & fmap Just
            mChainPoint <- lift queryChainPoint & onLeft (left . QueryCmdUnsupportedNtcVersion) & fmap Just
            mSystemStart <- lift querySystemStart & onLeft (left . QueryCmdUnsupportedNtcVersion) & fmap Just

            return
              O.QueryTipLocalState
                { O.era = era
                , O.eraHistory = eraHistory
                , O.mSystemStart = mSystemStart
                , O.mChainTip = makeChainTip <$> mChainBlockNo <*> mChainPoint
                }

    mLocalState <- hushM (first QueryCmdAcquireFailure eLocalState) $ \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 <-
      case mLocalState >>= 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 tipSlotNo :: SlotNo = case chainTip of
          ChainTip
ChainTipAtGenesis -> SlotNo
0
          ChainTip SlotNo
slotNo Hash BlockHeader
_ BlockNo
_ -> SlotNo
slotNo

    localStateOutput <- forM mLocalState $ \QueryTipLocalState (ZonkAny 0)
localState -> do
      case SlotNo
-> EraHistory
-> Either
     PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
slotToEpoch SlotNo
tipSlotNo (QueryTipLocalState (ZonkAny 0) -> EraHistory
forall mode. QueryTipLocalState mode -> EraHistory
O.eraHistory QueryTipLocalState (ZonkAny 0)
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
          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
            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 (ZonkAny 0) -> Maybe SystemStart
forall mode. QueryTipLocalState mode -> Maybe SystemStart
O.mSystemStart QueryTipLocalState (ZonkAny 0)
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
            nowSeconds <- toRelativeTime (SystemStart systemStart) <$> liftIO getCurrentTime
            tipTimeResult <-
              getProgress tipSlotNo (O.eraHistory localState) & bimap QueryCmdPastHorizon fst & except

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

            return $ percentage tolerance tipTimeResult nowSeconds

          mSyncProgress <- hushM syncProgressResult $ \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

          return $
            O.QueryTipLocalStateOutput
              { O.localStateChainTip = chainTip
              , O.mEra = Just (O.era localState)
              , O.mEpoch = Just epochNo
              , O.mSlotInEpoch = Just slotsInEpoch
              , O.mSlotsToEpochEnd = Just slotsToEpochEnd
              , O.mSyncProgress = mSyncProgress
              }

    let 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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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 cEra) <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          case forEraInEonMaybe cEra 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 <- 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)
              hoist liftIO $ writeFilteredUTxOs sbe outputFormat mOutFile 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
    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

    output <-
      fromEitherIOCli
        ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
            AnyCardanoEra cEra <- easyRunQueryCurrentEra

            era <- hoist liftIO $ supportedEra cEra
            let 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
            gParams <- easyRunQuery (queryGenesisParameters sbe)

            eraHistory <- easyRunQueryEraHistory

            let 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.
            ptclState <- easyRunQuery (queryProtocolState sbe)

            chainTip <- liftIO $ getLocalChainTip nodeConnInfo

            let curKesPeriod = ChainTip -> GenesisParameters ShelleyEra -> CurrentKesPeriod
forall era. ChainTip -> GenesisParameters era -> CurrentKesPeriod
currentKesPeriod ChainTip
chainTip GenesisParameters ShelleyEra
gParams
                oCertStartKesPeriod = OperationalCertificate -> OpCertStartingKesPeriod
opCertStartingKesPeriod OperationalCertificate
opCert
                oCertEndKesPeriod = GenesisParameters ShelleyEra
-> OperationalCertificate -> OpCertEndingKesPeriod
forall era.
GenesisParameters era
-> OperationalCertificate -> OpCertEndingKesPeriod
opCertEndKesPeriod GenesisParameters ShelleyEra
gParams OperationalCertificate
opCert
                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

            (onDiskC, stateC) <-
              Exp.obtainCommonConstraints era $
                hoist liftIO $
                  opCertOnDiskAndStateCounters ptclState opCert

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

            -- Always render diagnostic information
            liftIO . putStrLn $
              docToString $
                renderOpCertIntervalInformation (unFile nodeOpCertFp) opCertIntervalInformation

            liftIO . putStrLn $
              docToString $
                renderOpCertNodeAndOnDiskCounterInformation (unFile nodeOpCertFp) counterInformation

            let 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

            return
              $ outputFormat
                & ( id
                      . Vary.on (\FormatJson
FormatJson -> QueryKesPeriodInfoOutput -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
                      . Vary.on (\FormatYaml
FormatYaml -> QueryKesPeriodInfoOutput -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
                      $ Vary.exhaustiveCase
                  )
              $ qKesInfoOutput
        )
        & fromEitherCIOCli

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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 <-
        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 = 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 blockIssuerHash =
            verificationKeyHash stakePoolVKey

      case Map.lookup (coerce blockIssuerHash) 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 cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          era <- hoist liftIO $ supportedEra cEra

          let 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 = 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

          result <- easyRunQuery (queryPoolState beo poolFilter)
          hoist liftIO $ writePoolState era outputFormat mOutFile 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
    localQuery <- case TxMempoolQuery
query of
      TxMempoolQueryTxExists TxId
tx -> do
        AnyCardanoEra 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
        pure $ LocalTxMonitoringQueryTx $ TxIdInMode era 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

    result <- liftIO $ queryTxMonitoringLocal nodeConnInfo localQuery

    let 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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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 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
    liftIO . putStr $ show 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
    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 cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

      era <- hoist liftIO $ supportedEra cEra

      let 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 = 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 <- easyRunQuery (queryUtxo sbe $ QueryUTxOByTxIn transactionInputs)

      newExceptT $
        runRIO () $
          catch
            ( fmap Right $
                writeFormattedOutput outputFormat mOutFile $
                  RefInputScriptSize $
                    getReferenceInputsSizeForTxIds beo (toLedgerUTxO sbe utxo) transactionInputs
            )
            (pure . Left . QueryCmdWriteFileError)
    fromEitherCli 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 cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          era <- hoist liftIO $ supportedEra cEra

          let 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 = 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

          result <- easyRunQuery (queryStakeSnapshot beo poolFilter)

          hoist liftIO $ obtainCommonConstraints era (writeStakeSnapshots outputFormat mOutFile) 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
    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 cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            era <- hoist liftIO $ supportedEra cEra
            let 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 <- easyRunQuery (queryDebugLedgerState sbe)

            hoist liftIO $
              obtainCommonConstraints era $
                outputFormat
                  & ( id
                        . 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.on (\FormatText
FormatText -> SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ByteString
forall (f :: * -> *) era.
Applicative f =>
SerialisedDebugLedgerState era -> f ByteString
ledgerStateAsTextByteString SerialisedDebugLedgerState era
serialisedDebugLedgerState)
                        . 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.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
    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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
    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 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 <- hoist liftIO $ supportedEra cEra
            let 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

            result <- easyRunQuery (queryLedgerPeerSnapshot sbe)

            shelleyNtcVersion <- hoistEither $ getShelleyNodeToClientVersion era globalNtcVersion

            hoist liftIO $
              obtainCommonConstraints era $
                case decodeBigLedgerPeerSnapshot shelleyNtcVersion 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 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 cEra) <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            era <-
              pure (forEraMaybeEon cEra)
                & onNothing (left $ QueryCmdEraNotSupported anyE)

            ps <- easyRunQuery (queryProtocolState (convert era))

            output <-
              hoist liftIO
                $ Exp.obtainCommonConstraints era
                $ outputFormat
                  & ( id
                        . Vary.on (\FormatCborBin
FormatCborBin -> ProtocolState era -> ExceptT QueryCmdError IO ByteString
forall era.
ProtocolState era -> ExceptT QueryCmdError IO ByteString
protocolStateToCborBinary)
                        . 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.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.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.exhaustiveCase
                    )
                $ ps

            fromEitherIOCli @(FileError ()) $
              writeLazyByteStringOutput mOutFile 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

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

    fromExceptTCli $ writeStakeAddressInfo said outputFormat 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 cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

        era <- hoist liftIO $ supportedEra cEra

        let 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 = 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 = 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

        (stakeRewardAccountBalances, stakePools) <-
          easyRunQuery (queryStakeAddresses sbe stakeAddr networkId)

        stakeDelegDeposits <- easyRunQuery (queryStakeDelegDeposits beo stakeAddr)

        (stakeVoteDelegatees, gaDeposits) <-
          monoidForEraInEonA
            (toCardanoEra beo)
            ( \ConwayEraOnwards era
ceo -> do
                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)

                govActionStates :: (Seq.Seq (L.GovActionState (ShelleyLedgerEra era))) <-
                  easyRunQuery $ queryProposals ceo Set.empty

                let 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
                          ]

                return (stakeVoteDelegatees, gaDeposits)
            )

        pure $
          StakeAddressInfoData
            (DelegationsAndRewards (stakeRewardAccountBalances, stakePools))
            (Map.mapKeys (makeStakeAddress networkId) stakeDelegDeposits)
            gaDeposits
            (Map.mapKeys (makeStakeAddress networkId) 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 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 =
        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

  firstExceptT QueryCmdWriteFileError
    . newExceptT
    $ writeLazyByteStringOutput mOutFile 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 <-
    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 = 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 =
        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

  firstExceptT QueryCmdWriteFileError
    . newExceptT
    $ writeLazyByteStringOutput mOutFile 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 cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          era <- hoist liftIO $ supportedEra cEra
          let 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
          poolIds <- easyRunQuery (queryStakePools sbe)

          fromExceptTCli $ writeStakePools outputFormat mOutFile 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 cEra <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

          era <- hoist liftIO $ supportedEra cEra
          let 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
          result <- easyRunQuery (queryStakeDistribution sbe)

          hoist liftIO $
            writeStakeDistribution outputFormat mOutFile 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 <- StakePoolKeyHashSource -> RIO e PoolId
forall (m :: * -> *).
MonadIO m =>
StakePoolKeyHashSource -> m PoolId
getHashFromStakePoolKeyHashSource StakePoolKeyHashSource
poolColdVerKeyFile

    vrkSkey <-
      fromEitherIOCli $
        readFileTextEnvelope @(SigningKey VrfKey) vrkSkeyFp

    shelleyGenesis <-
      fromExceptTCli $
        decodeShelleyGenesisFile genFile

    fromExceptTCli . join $
      lift
        ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
            AnyCardanoEra cEra <- easyRunQueryCurrentEra

            era <- hoist liftIO $ supportedEra cEra
            let 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 <- easyRunQuery (queryProtocolParameters sbe)
            ptclState <- easyRunQuery (queryProtocolState sbe)
            eraHistory <- easyRunQueryEraHistory

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

            curentEpoch <- easyRunQuery (queryEpoch sbe)

            case 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

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

                pure $ do
                  schedule <-
                    firstExceptT QueryCmdLeaderShipError $
                      hoistEither $
                        obtainCommonConstraints era $
                          currentEpochEligibleLeadershipSlots
                            sbe
                            shelleyGenesis
                            eInfo
                            pparams
                            ptclState
                            poolid
                            vrkSkey
                            serCurrentEpochState
                            curentEpoch

                  writeSchedule mOutFile eInfo shelleyGenesis schedule
              EpochLeadershipSchedule
NextEpoch -> do
                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)

                pure $ do
                  tip <- liftIO $ getLocalChainTip nodeConnInfo

                  schedule <-
                    firstExceptT QueryCmdLeaderShipError $
                      hoistEither $
                        obtainCommonConstraints era $
                          nextEpochEligibleLeadershipSlots
                            sbe
                            shelleyGenesis
                            serCurrentEpochState
                            ptclState
                            poolid
                            vrkSkey
                            pparams
                            eInfo
                            (tip, curentEpoch)

                  writeSchedule mOutFile eInfo shelleyGenesis schedule
        )
        & onLeft (left . QueryCmdAcquireFailure)
        & onLeft 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 <- 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 =
          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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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
    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 =
          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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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 <- 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 =
          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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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
    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

    when (isNothing futurePParams) $
      liftIO . T.hPutStrLn IO.stderr $
        "No protocol parameter changes will be enacted at the next epoch boundary."

    let 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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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
    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

    drepState <- fromExceptTCli $ runQuery nodeConnInfo target $ queryDRepState eon $ fromList drepCreds

    drepStakeDistribution <-
      case 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 -> Item (Set DRep)
Credential 'DRepRole -> DRep
L.DRepCredential (Credential 'DRepRole -> Item (Set DRep))
-> [Credential 'DRepRole] -> [Item (Set 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 assocs :: [(L.Credential L.DRepRole, L.DRepState)] = Map.assocs drepState
        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 =
          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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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
    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

    drepStakeDistribution <-
      fromExceptTCli $ runQuery nodeConnInfo target $ queryDRepStakeDistribution eon dreps

    let 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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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

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

    spoStakeDistribution :: Map (L.KeyHash L.StakePool) L.Coin <-
      fromExceptTCli $ runQuery nodeConnInfo target $ querySPOStakeDistribution eon spos

    let poolIds :: Set (Hash StakePoolKey) = Set.fromList $ map StakePoolKeyHash $ Map.keys spoStakeDistribution

    serialisedPoolState <-
      fromExceptTCli $ runQuery nodeConnInfo target $ queryPoolState beo (Just poolIds)

    PoolState poolStateResult <-
      fromEitherCli $ decodePoolState (convert eon) serialisedPoolState

    let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential 'L.Staking)
        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 = [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

    rewardCredToDRep <-
      fromExceptTCli $ runQuery nodeConnInfo target $ queryStakeVoteDelegatees eon allRewardCreds

    let spoToDelegatee :: Map (L.KeyHash L.StakePool) L.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
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 =
          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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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
    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 =
          (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
    hotKeys <- fromList <$> mapM hotKeysFromVerKeyHashOrFile hotCredKeys

    committeeState <-
      fromExceptTCli $
        runQuery nodeConnInfo target $
          queryCommitteeMembersState eon coldKeys hotKeys (fromList memberStatuses)

    let 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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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 <-
      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 treasury) = casTreasury chainAccountState
        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

    fromEitherCIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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

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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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 <-
      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 = Maybe TextEnvelopeDescr -> EraHistory -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing EraHistory
eraHistory

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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
    spo <- SPOHashSource -> CIO e (KeyHash 'StakePool)
forall e. SPOHashSource -> CIO e (KeyHash 'StakePool)
spoFromSource SPOHashSource
spoHashSources

    defVote :: L.DefaultVote <-
      fromExceptTCli $
        runQuery nodeConnInfo target $
          queryStakePoolDefaultVote eon spo

    let 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

    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringOutput mOutFile 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 <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  SystemStart
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  SystemStart
easyRunQuerySystemStart
        eraHistory <- easyRunQueryEraHistory

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

        pure (Api.getSlotForRelativeTime relTime eraHistory)
          & onLeft (left . 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))