{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Cardano.CLI.Shelley.Run.Query
( DelegationsAndRewards(..)
, ShelleyQueryCmdError
, ShelleyQueryCmdLocalStateQueryError (..)
, renderOpCertIntervalInformation
, renderShelleyQueryCmdError
, renderLocalStateQueryError
, runQueryCmd
, mergeDelegsAndRewards
, percentage
, executeQuery
) where
import Cardano.Prelude
import Prelude (String, id)
import Cardano.Api
import qualified Cardano.Api as Api
import Cardano.Api.Byron
import Cardano.Api.Orphans ()
import Cardano.Api.Shelley
import Cardano.Binary (DecoderError)
import Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import Cardano.CLI.Helpers (HelpersError (..), hushM, pPrintCBOR, renderHelpersError)
import Cardano.CLI.Shelley.Commands
import Cardano.CLI.Shelley.Key (InputDecodeError, VerificationKeyOrHashOrFile,
readVerificationKeyOrHashOrFile)
import Cardano.CLI.Shelley.Orphans ()
import qualified Cardano.CLI.Shelley.Output as O
import Cardano.CLI.Shelley.Run.Genesis (ShelleyGenesisCmdError,
readAndDecodeShelleyGenesis)
import Cardano.CLI.Types
import Cardano.Crypto.Hash (hashToBytesAsHex)
import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
import qualified Cardano.Crypto.VRF as Crypto
import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
import Cardano.Ledger.BaseTypes (Seed, UnitInterval)
import Cardano.Ledger.Coin
import Cardano.Ledger.Compactible
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Credential as Ledger
import qualified Cardano.Ledger.Crypto as Crypto
import qualified Cardano.Ledger.Era as Era
import qualified Cardano.Ledger.Era as Ledger
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.Shelley.Constraints
import Cardano.Ledger.Shelley.EpochBoundary
import Cardano.Ledger.Shelley.LedgerState (DPState (..),
EpochState (esLState, esSnapshots), LedgerState (..), NewEpochState (nesEs),
PState (_fPParams, _pParams, _retiring))
import qualified Cardano.Ledger.Shelley.PParams as Shelley
import Cardano.Ledger.Shelley.Scripts ()
import Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCTime, hoistEpochInfo)
import Control.Monad.Trans.Except (except)
import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistMaybe, left,
newExceptT, hoistEither)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Types as Aeson
import Data.Coerce (coerce)
import Data.List (nub)
import Data.Sharing (Interns, Share)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Time.Clock
import Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime (..),
SystemStart (..), toRelativeTime)
import Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..))
import Ouroboros.Consensus.Protocol.TPraos
import Ouroboros.Network.Block (Serialised (..))
import Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..))
import Text.Printf (printf)
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.VMap as VMap
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.IO as T
import qualified Data.Text.IO as Text
import qualified Data.Vector as Vector
import Formatting.Buildable (build)
import Numeric (showEFloat)
import qualified Ouroboros.Consensus.HardFork.History as Consensus
import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
import qualified System.IO as IO
data ShelleyQueryCmdError
= ShelleyQueryCmdEnvVarSocketErr !EnvSocketError
| ShelleyQueryCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError
| ShelleyQueryCmdWriteFileError !(FileError ())
| ShelleyQueryCmdHelpersError !HelpersError
| ShelleyQueryCmdAcquireFailure !AcquireFailure
| ShelleyQueryCmdEraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra
| ShelleyQueryCmdByronEra
| ShelleyQueryCmdPoolIdError (Hash StakePoolKey)
| ShelleyQueryCmdEraMismatch !EraMismatch
| ShelleyQueryCmdUnsupportedMode !AnyConsensusMode
| ShelleyQueryCmdPastHorizon !Qry.PastHorizonException
| ShelleyQueryCmdSystemStartUnavailable
| ShelleyQueryCmdGenesisReadError !ShelleyGenesisCmdError
| ShelleyQueryCmdLeaderShipError !LeadershipError
| ShelleyQueryCmdTextEnvelopeReadError !(FileError TextEnvelopeError)
| ShelleyQueryCmdTextReadError !(FileError InputDecodeError )
| ShelleyQueryCmdColdKeyReadFileError !(FileError InputDecodeError)
| ShelleyQueryCmdOpCertCounterReadError !(FileError TextEnvelopeError)
| ShelleyQueryCmdProtocolStateDecodeFailure !(LBS.ByteString, DecoderError)
| ShelleyQueryCmdSlotToUtcError Text
| ShelleyQueryCmdNodeUnknownStakePool
FilePath
deriving Int -> ShelleyQueryCmdError -> ShowS
[ShelleyQueryCmdError] -> ShowS
ShelleyQueryCmdError -> String
(Int -> ShelleyQueryCmdError -> ShowS)
-> (ShelleyQueryCmdError -> String)
-> ([ShelleyQueryCmdError] -> ShowS)
-> Show ShelleyQueryCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyQueryCmdError] -> ShowS
$cshowList :: [ShelleyQueryCmdError] -> ShowS
show :: ShelleyQueryCmdError -> String
$cshow :: ShelleyQueryCmdError -> String
showsPrec :: Int -> ShelleyQueryCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyQueryCmdError -> ShowS
Show
renderShelleyQueryCmdError :: ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError :: ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError ShelleyQueryCmdError
err =
case ShelleyQueryCmdError
err of
ShelleyQueryCmdEnvVarSocketErr EnvSocketError
envSockErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
envSockErr
ShelleyQueryCmdLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
lsqErr -> ShelleyQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
lsqErr
ShelleyQueryCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
ShelleyQueryCmdHelpersError HelpersError
helpersErr -> HelpersError -> Text
renderHelpersError HelpersError
helpersErr
ShelleyQueryCmdAcquireFailure AcquireFailure
acquireFail -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ AcquireFailure -> String
forall a b. (Show a, ConvertText String b) => a -> b
show AcquireFailure
acquireFail
ShelleyQueryCmdError
ShelleyQueryCmdByronEra -> Text
"This query cannot be used for the Byron era"
ShelleyQueryCmdPoolIdError Hash StakePoolKey
poolId -> Text
"The pool id does not exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash StakePoolKey -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Hash StakePoolKey
poolId
ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode ConsensusMode mode
cMode) (AnyCardanoEra CardanoEra era
era) ->
Text
"Consensus mode and era mismatch. Consensus mode: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConsensusMode mode -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ConsensusMode mode
cMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" Era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show CardanoEra era
era
ShelleyQueryCmdEraMismatch (EraMismatch Text
ledgerEra Text
queryEra) ->
Text
"\nAn error mismatch occurred." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nSpecified query era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
queryEra Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\nCurrent ledger era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ledgerEra
ShelleyQueryCmdUnsupportedMode AnyConsensusMode
mode -> Text
"Unsupported mode: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyConsensusMode -> Text
renderMode AnyConsensusMode
mode
ShelleyQueryCmdPastHorizon PastHorizonException
e -> Text
"Past horizon: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PastHorizonException -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show PastHorizonException
e
ShelleyQueryCmdError
ShelleyQueryCmdSystemStartUnavailable -> Text
"System start unavailable"
ShelleyQueryCmdGenesisReadError ShelleyGenesisCmdError
err' -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShelleyGenesisCmdError -> String
forall e. Error e => e -> String
displayError ShelleyGenesisCmdError
err'
ShelleyQueryCmdLeaderShipError LeadershipError
e -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ LeadershipError -> String
forall e. Error e => e -> String
displayError LeadershipError
e
ShelleyQueryCmdTextEnvelopeReadError FileError TextEnvelopeError
e -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> String
forall e. Error e => e -> String
displayError FileError TextEnvelopeError
e
ShelleyQueryCmdSlotToUtcError Text
e -> Text
"Failed to convert slot to UTC time: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
ShelleyQueryCmdTextReadError FileError InputDecodeError
e -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FileError InputDecodeError -> String
forall e. Error e => e -> String
displayError FileError InputDecodeError
e
ShelleyQueryCmdColdKeyReadFileError FileError InputDecodeError
e -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FileError InputDecodeError -> String
forall e. Error e => e -> String
displayError FileError InputDecodeError
e
ShelleyQueryCmdOpCertCounterReadError FileError TextEnvelopeError
e -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> String
forall e. Error e => e -> String
displayError FileError TextEnvelopeError
e
ShelleyQueryCmdProtocolStateDecodeFailure (ByteString
_, DecoderError
decErr) ->
Text
"Failed to decode the protocol state: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
toStrict (Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ DecoderError -> Builder
forall p. Buildable p => p -> Builder
build DecoderError
decErr)
ShelleyQueryCmdNodeUnknownStakePool String
nodeOpCert ->
String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"The stake pool associated with: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
nodeOpCert String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was not found. Ensure the correct KES key has been " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"specified and that the stake pool is registered. If you have submitted a stake pool registration certificate " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
"in the current epoch, you must wait until the following epoch for the registration to take place."
runQueryCmd :: QueryCmd -> ExceptT ShelleyQueryCmdError IO ()
runQueryCmd :: QueryCmd -> ExceptT ShelleyQueryCmdError IO ()
runQueryCmd QueryCmd
cmd =
case QueryCmd
cmd of
QueryLeadershipSchedule AnyConsensusModeParams
consensusModeParams NetworkId
network GenesisFile
shelleyGenFp VerificationKeyOrHashOrFile StakePoolKey
poolid SigningKeyFile
vrkSkeyFp EpochLeadershipSchedule
whichSchedule Maybe OutputFile
outputAs ->
AnyConsensusModeParams
-> NetworkId
-> GenesisFile
-> VerificationKeyOrHashOrFile StakePoolKey
-> SigningKeyFile
-> EpochLeadershipSchedule
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLeadershipSchedule AnyConsensusModeParams
consensusModeParams NetworkId
network GenesisFile
shelleyGenFp VerificationKeyOrHashOrFile StakePoolKey
poolid SigningKeyFile
vrkSkeyFp EpochLeadershipSchedule
whichSchedule Maybe OutputFile
outputAs
QueryProtocolParameters' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryTip AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryTip AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryStakePools' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakePools AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryStakeDistribution' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryStakeAddressInfo AnyConsensusModeParams
consensusModeParams StakeAddress
addr NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo AnyConsensusModeParams
consensusModeParams StakeAddress
addr NetworkId
network Maybe OutputFile
mOutFile
QueryDebugLedgerState' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryStakeSnapshot' AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid ->
AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeSnapshot AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid
QueryPoolParams' AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid ->
AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryPoolParams AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid
QueryProtocolState' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolState AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryUTxO' AnyConsensusModeParams
consensusModeParams QueryUTxOFilter
qFilter NetworkId
networkId Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> QueryUTxOFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO AnyConsensusModeParams
consensusModeParams QueryUTxOFilter
qFilter NetworkId
networkId Maybe OutputFile
mOutFile
QueryKesPeriodInfo AnyConsensusModeParams
consensusModeParams NetworkId
network String
nodeOpCert Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> String
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryKesPeriodInfo AnyConsensusModeParams
consensusModeParams NetworkId
network String
nodeOpCert Maybe OutputFile
mOutFile
runQueryProtocolParameters
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr
ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters)
result <- IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters))
-> ExceptT
ShelleyQueryCmdError
IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters))
-> ExceptT
ShelleyQueryCmdError
IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters)))
-> IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters))
-> ExceptT
ShelleyQueryCmdError
IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError ProtocolParameters))
-> IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters))
forall mode a.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (Either AcquireFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing ((NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError ProtocolParameters))
-> IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters)))
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError ProtocolParameters))
-> IO
(Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters))
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
_ntcVersion -> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError ProtocolParameters)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError ProtocolParameters))
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ do
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ ConsensusModeParams mode
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
AnyCardanoEra
forall mode block point r.
ConsensusModeParams mode
-> LocalStateQueryExpr
block point (QueryInMode mode) r IO AnyCardanoEra
determineEraExpr ConsensusModeParams mode
cModeParams
case CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era of
CardanoEraStyle era
LegacyByronEra -> ShelleyQueryCmdError
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyQueryCmdError
ShelleyQueryCmdByronEra
ShelleyBasedEra ShelleyBasedEra era
sbe -> do
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
EraInMode era mode
eInMode <- CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode
Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(EraInMode era mode))
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(EraInMode era mode)
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE)
Either EraMismatch ProtocolParameters
ppResult <- LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch ProtocolParameters)
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch ProtocolParameters)
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters))
-> (QueryInMode mode (Either EraMismatch ProtocolParameters)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch ProtocolParameters))
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryInMode mode (Either EraMismatch ProtocolParameters)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch ProtocolParameters)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters))
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ EraInMode era mode
-> QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era ProtocolParameters
-> QueryInEra era ProtocolParameters
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era ProtocolParameters
forall era. QueryInShelleyBasedEra era ProtocolParameters
QueryProtocolParameters
Either EraMismatch ProtocolParameters
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except Either EraMismatch ProtocolParameters
ppResult ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> (ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters)
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
forall a b. a -> (a -> b) -> b
& (EraMismatch -> ShelleyQueryCmdError)
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> ShelleyQueryCmdError
ShelleyQueryCmdEraMismatch
Maybe OutputFile
-> ProtocolParameters -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolParameters Maybe OutputFile
mOutFile (ProtocolParameters -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO ProtocolParameters
-> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either ShelleyQueryCmdError ProtocolParameters
-> ExceptT ShelleyQueryCmdError IO ProtocolParameters
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either
ShelleyQueryCmdError
(Either ShelleyQueryCmdError ProtocolParameters)
-> Either ShelleyQueryCmdError ProtocolParameters
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((AcquireFailure -> ShelleyQueryCmdError)
-> Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters)
-> Either
ShelleyQueryCmdError
(Either ShelleyQueryCmdError ProtocolParameters)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquireFailure -> ShelleyQueryCmdError
ShelleyQueryCmdAcquireFailure Either
AcquireFailure (Either ShelleyQueryCmdError ProtocolParameters)
result))
where
writeProtocolParameters
:: Maybe OutputFile
-> ProtocolParameters
-> ExceptT ShelleyQueryCmdError IO ()
writeProtocolParameters :: Maybe OutputFile
-> ProtocolParameters -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolParameters Maybe OutputFile
mOutFile' ProtocolParameters
pparams =
case Maybe OutputFile
mOutFile' of
Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (ProtocolParameters -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ProtocolParameters
pparams)
Just (OutputFile String
fpath) ->
(IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
String -> ByteString -> IO ()
LBS.writeFile String
fpath (ProtocolParameters -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ProtocolParameters
pparams)
percentage
:: RelativeTime
-> RelativeTime
-> RelativeTime
-> Text
percentage :: RelativeTime -> RelativeTime -> RelativeTime -> Text
percentage RelativeTime
tolerance RelativeTime
a RelativeTime
b = String -> Text
Text.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f" Double
pc)
where
t :: Integer
t = RelativeTime -> Integer
relativeTimeSeconds RelativeTime
tolerance
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
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
pc :: Double
pc = Double -> Double
forall a. a -> a
id @Double (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
relativeTimeSeconds :: RelativeTime -> Integer
relativeTimeSeconds :: RelativeTime -> Integer
relativeTimeSeconds (RelativeTime NominalDiffTime
dt) = Pico -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
dt)
queryChainTipViaChainSync :: MonadIO m => LocalNodeConnectInfo mode -> m ChainTip
queryChainTipViaChainSync :: LocalNodeConnectInfo mode -> m ChainTip
queryChainTipViaChainSync LocalNodeConnectInfo mode
localNodeConnInfo = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 (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 mode -> IO ChainTip
forall mode. LocalNodeConnectInfo mode -> IO ChainTip
getLocalChainTip LocalNodeConnectInfo mode
localNodeConnInfo
runQueryTip
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryTip :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryTip (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
case ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams of
ConsensusMode mode
CardanoMode -> do
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
Either AcquireFailure (QueryTipLocalState Any)
eLocalState <- IO (Either AcquireFailure (QueryTipLocalState Any))
-> ExceptT
ShelleyQueryCmdError
IO
(Either AcquireFailure (QueryTipLocalState Any))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either AcquireFailure (QueryTipLocalState Any))
-> ExceptT
ShelleyQueryCmdError
IO
(Either AcquireFailure (QueryTipLocalState Any)))
-> IO (Either AcquireFailure (QueryTipLocalState Any))
-> ExceptT
ShelleyQueryCmdError
IO
(Either AcquireFailure (QueryTipLocalState Any))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(QueryTipLocalState Any))
-> IO (Either AcquireFailure (QueryTipLocalState Any))
forall mode a.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (Either AcquireFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing ((NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(QueryTipLocalState Any))
-> IO (Either AcquireFailure (QueryTipLocalState Any)))
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(QueryTipLocalState Any))
-> IO (Either AcquireFailure (QueryTipLocalState Any))
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
ntcVersion -> do
AnyCardanoEra
era <- QueryInMode CardanoMode AnyCardanoEra
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
AnyCardanoEra
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode AnyCardanoEra
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode AnyCardanoEra
QueryCurrentEra ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra)
EraHistory CardanoMode
eraHistory <- QueryInMode CardanoMode (EraHistory CardanoMode)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
(EraHistory CardanoMode)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode (EraHistory CardanoMode)
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
QueryEraHistory ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra)
Maybe (WithOrigin BlockNo)
mChainBlockNo <- if NodeToClientVersion
ntcVersion NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_10
then WithOrigin BlockNo -> Maybe (WithOrigin BlockNo)
forall a. a -> Maybe a
Just (WithOrigin BlockNo -> Maybe (WithOrigin BlockNo))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(WithOrigin BlockNo)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Maybe (WithOrigin BlockNo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryInMode mode (WithOrigin BlockNo)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(WithOrigin BlockNo)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr QueryInMode mode (WithOrigin BlockNo)
forall mode. QueryInMode mode (WithOrigin BlockNo)
QueryChainBlockNo
else Maybe (WithOrigin BlockNo)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Maybe (WithOrigin BlockNo))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (WithOrigin BlockNo)
forall a. Maybe a
Nothing
Maybe ChainPoint
mChainPoint <- if NodeToClientVersion
ntcVersion NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_10
then ChainPoint -> Maybe ChainPoint
forall a. a -> Maybe a
Just (ChainPoint -> Maybe ChainPoint)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
ChainPoint
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
(Maybe ChainPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryInMode CardanoMode ChainPoint
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
ChainPoint
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (ConsensusMode CardanoMode -> QueryInMode CardanoMode ChainPoint
forall mode. ConsensusMode mode -> QueryInMode mode ChainPoint
QueryChainPoint ConsensusMode CardanoMode
CardanoMode)
else Maybe ChainPoint
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Maybe ChainPoint)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChainPoint
forall a. Maybe a
Nothing
Maybe SystemStart
mSystemStart <- if NodeToClientVersion
ntcVersion NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_9
then SystemStart -> Maybe SystemStart
forall a. a -> Maybe a
Just (SystemStart -> Maybe SystemStart)
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO SystemStart
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Maybe SystemStart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryInMode mode SystemStart
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO SystemStart
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr QueryInMode mode SystemStart
forall mode. QueryInMode mode SystemStart
QuerySystemStart
else Maybe SystemStart
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Maybe SystemStart)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SystemStart
forall a. Maybe a
Nothing
QueryTipLocalState Any
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(QueryTipLocalState Any)
forall (m :: * -> *) a. Monad m => a -> m a
return QueryTipLocalState :: forall mode.
AnyCardanoEra
-> EraHistory CardanoMode
-> Maybe SystemStart
-> Maybe ChainTip
-> QueryTipLocalState mode
O.QueryTipLocalState
{ $sel:era:QueryTipLocalState :: AnyCardanoEra
O.era = AnyCardanoEra
era
, $sel:eraHistory:QueryTipLocalState :: EraHistory CardanoMode
O.eraHistory = EraHistory CardanoMode
eraHistory
, $sel:mSystemStart:QueryTipLocalState :: Maybe SystemStart
O.mSystemStart = Maybe SystemStart
mSystemStart
, $sel:mChainTip:QueryTipLocalState :: Maybe ChainTip
O.mChainTip = WithOrigin BlockNo -> ChainPoint -> ChainTip
makeChainTip (WithOrigin BlockNo -> ChainPoint -> ChainTip)
-> Maybe (WithOrigin BlockNo) -> Maybe (ChainPoint -> ChainTip)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (WithOrigin BlockNo)
mChainBlockNo Maybe (ChainPoint -> ChainTip)
-> Maybe ChainPoint -> Maybe ChainTip
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChainPoint
mChainPoint
}
Maybe (QueryTipLocalState Any)
mLocalState <- Either ShelleyQueryCmdError (QueryTipLocalState Any)
-> (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe (QueryTipLocalState Any))
forall e (m :: * -> *) a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM ((AcquireFailure -> ShelleyQueryCmdError)
-> Either AcquireFailure (QueryTipLocalState Any)
-> Either ShelleyQueryCmdError (QueryTipLocalState Any)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquireFailure -> ShelleyQueryCmdError
ShelleyQueryCmdAcquireFailure Either AcquireFailure (QueryTipLocalState Any)
eLocalState) ((ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT
ShelleyQueryCmdError IO (Maybe (QueryTipLocalState Any)))
-> (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe (QueryTipLocalState Any))
forall a b. (a -> b) -> a -> b
$ \ShelleyQueryCmdError
e ->
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Handle -> Text -> IO ()
T.hPutStrLn Handle
IO.stderr (Text -> ExceptT ShelleyQueryCmdError IO ())
-> Text -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Warning: Local state unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError ShelleyQueryCmdError
e
ChainTip
chainTip <- case Maybe (QueryTipLocalState Any)
mLocalState Maybe (QueryTipLocalState Any)
-> (QueryTipLocalState Any -> Maybe ChainTip) -> Maybe ChainTip
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalState Any -> Maybe ChainTip
forall mode. QueryTipLocalState mode -> Maybe ChainTip
O.mChainTip of
Just ChainTip
chainTip -> ChainTip -> ExceptT ShelleyQueryCmdError IO ChainTip
forall (m :: * -> *) a. Monad m => a -> m a
return ChainTip
chainTip
Maybe ChainTip
Nothing -> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO ChainTip
forall (m :: * -> *) mode.
MonadIO m =>
LocalNodeConnectInfo mode -> m ChainTip
queryChainTipViaChainSync LocalNodeConnectInfo mode
localNodeConnInfo
let SlotNo
tipSlotNo :: SlotNo = case ChainTip
chainTip of
ChainTip
ChainTipAtGenesis -> SlotNo
0
ChainTip SlotNo
slotNo Hash BlockHeader
_ BlockNo
_ -> SlotNo
slotNo
Maybe QueryTipLocalStateOutput
localStateOutput <- Maybe (QueryTipLocalState Any)
-> (QueryTipLocalState Any
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput)
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (QueryTipLocalState Any)
mLocalState ((QueryTipLocalState Any
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput)
-> ExceptT
ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> (QueryTipLocalState Any
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput)
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall a b. (a -> b) -> a -> b
$ \QueryTipLocalState Any
localState -> do
case SlotNo
-> EraHistory CardanoMode
-> Either
PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
forall mode.
SlotNo
-> EraHistory mode
-> Either
PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
slotToEpoch SlotNo
tipSlotNo (QueryTipLocalState Any -> EraHistory CardanoMode
forall mode. QueryTipLocalState mode -> EraHistory CardanoMode
O.eraHistory QueryTipLocalState Any
localState) of
Left PastHorizonException
e -> do
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Handle -> Text -> IO ()
T.hPutStrLn Handle
IO.stderr (Text -> ExceptT ShelleyQueryCmdError IO ())
-> Text -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
Text
"Warning: Epoch unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError (PastHorizonException -> ShelleyQueryCmdError
ShelleyQueryCmdPastHorizon PastHorizonException
e)
QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput)
-> QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$ QueryTipLocalStateOutput :: ChainTip
-> Maybe AnyCardanoEra
-> Maybe EpochNo
-> Maybe Text
-> QueryTipLocalStateOutput
O.QueryTipLocalStateOutput
{ $sel:localStateChainTip:QueryTipLocalStateOutput :: ChainTip
O.localStateChainTip = ChainTip
chainTip
, $sel:mEra:QueryTipLocalStateOutput :: Maybe AnyCardanoEra
O.mEra = Maybe AnyCardanoEra
forall a. Maybe a
Nothing
, $sel:mEpoch:QueryTipLocalStateOutput :: Maybe EpochNo
O.mEpoch = Maybe EpochNo
forall a. Maybe a
Nothing
, $sel:mSyncProgress:QueryTipLocalStateOutput :: Maybe Text
O.mSyncProgress = Maybe Text
forall a. Maybe a
Nothing
}
Right (EpochNo
epochNo, SlotsInEpoch
_, SlotsToEpochEnd
_) -> do
Either ShelleyQueryCmdError Text
syncProgressResult <- ExceptT ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
-> ExceptT
ShelleyQueryCmdError IO (Either ShelleyQueryCmdError Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
-> ExceptT
ShelleyQueryCmdError IO (Either ShelleyQueryCmdError Text))
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
-> ExceptT
ShelleyQueryCmdError IO (Either ShelleyQueryCmdError Text)
forall a b. (a -> b) -> a -> b
$ do
UTCTime
systemStart <- (SystemStart -> UTCTime) -> Maybe SystemStart -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SystemStart -> UTCTime
getSystemStart (QueryTipLocalState Any -> Maybe SystemStart
forall mode. QueryTipLocalState mode -> Maybe SystemStart
O.mSystemStart QueryTipLocalState Any
localState) Maybe UTCTime
-> (Maybe UTCTime
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime)
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe UTCTime
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe ShelleyQueryCmdError
ShelleyQueryCmdSystemStartUnavailable
RelativeTime
nowSeconds <- SystemStart -> UTCTime -> RelativeTime
toRelativeTime (UTCTime -> SystemStart
SystemStart UTCTime
systemStart) (UTCTime -> RelativeTime)
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
RelativeTime
tipTimeResult <- SlotNo
-> EraHistory CardanoMode
-> Either PastHorizonException (RelativeTime, SlotLength)
forall mode.
SlotNo
-> EraHistory mode
-> Either PastHorizonException (RelativeTime, SlotLength)
getProgress SlotNo
tipSlotNo (QueryTipLocalState Any -> EraHistory CardanoMode
forall mode. QueryTipLocalState mode -> EraHistory CardanoMode
O.eraHistory QueryTipLocalState Any
localState) Either PastHorizonException (RelativeTime, SlotLength)
-> (Either PastHorizonException (RelativeTime, SlotLength)
-> Either ShelleyQueryCmdError RelativeTime)
-> Either ShelleyQueryCmdError RelativeTime
forall a b. a -> (a -> b) -> b
& (PastHorizonException -> ShelleyQueryCmdError)
-> ((RelativeTime, SlotLength) -> RelativeTime)
-> Either PastHorizonException (RelativeTime, SlotLength)
-> Either ShelleyQueryCmdError RelativeTime
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap PastHorizonException -> ShelleyQueryCmdError
ShelleyQueryCmdPastHorizon (RelativeTime, SlotLength) -> RelativeTime
forall a b. (a, b) -> a
fst Either ShelleyQueryCmdError RelativeTime
-> (Either ShelleyQueryCmdError RelativeTime
-> ExceptT
ShelleyQueryCmdError
(ExceptT ShelleyQueryCmdError IO)
RelativeTime)
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) RelativeTime
forall a b. a -> (a -> b) -> b
& Either ShelleyQueryCmdError RelativeTime
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) RelativeTime
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except
let tolerance :: RelativeTime
tolerance = NominalDiffTime -> RelativeTime
RelativeTime (Pico -> NominalDiffTime
secondsToNominalDiffTime Pico
600)
Text
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text)
-> Text
-> ExceptT
ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
forall a b. (a -> b) -> a -> b
$ (RelativeTime -> RelativeTime -> Text)
-> RelativeTime -> RelativeTime -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RelativeTime -> RelativeTime -> RelativeTime -> Text
percentage RelativeTime
tolerance) RelativeTime
nowSeconds RelativeTime
tipTimeResult
Maybe Text
mSyncProgress <- Either ShelleyQueryCmdError Text
-> (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe Text)
forall e (m :: * -> *) a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM Either ShelleyQueryCmdError Text
syncProgressResult ((ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe Text))
-> (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ShelleyQueryCmdError
e -> do
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Handle -> Text -> IO ()
T.hPutStrLn Handle
IO.stderr (Text -> ExceptT ShelleyQueryCmdError IO ())
-> Text -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Warning: Sync progress unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError ShelleyQueryCmdError
e
QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput)
-> QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$ QueryTipLocalStateOutput :: ChainTip
-> Maybe AnyCardanoEra
-> Maybe EpochNo
-> Maybe Text
-> QueryTipLocalStateOutput
O.QueryTipLocalStateOutput
{ $sel:localStateChainTip:QueryTipLocalStateOutput :: ChainTip
O.localStateChainTip = ChainTip
chainTip
, $sel:mEra:QueryTipLocalStateOutput :: Maybe AnyCardanoEra
O.mEra = AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (QueryTipLocalState Any -> AnyCardanoEra
forall mode. QueryTipLocalState mode -> AnyCardanoEra
O.era QueryTipLocalState Any
localState)
, $sel:mEpoch:QueryTipLocalStateOutput :: Maybe EpochNo
O.mEpoch = EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
epochNo
, $sel:mSyncProgress:QueryTipLocalStateOutput :: Maybe Text
O.mSyncProgress = Maybe Text
mSyncProgress
}
case Maybe OutputFile
mOutFile of
Just (OutputFile String
fpath) -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe QueryTipLocalStateOutput -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Maybe QueryTipLocalStateOutput
localStateOutput
Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe QueryTipLocalStateOutput -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Maybe QueryTipLocalStateOutput
localStateOutput
ConsensusMode mode
mode -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (AnyConsensusMode -> ShelleyQueryCmdError
ShelleyQueryCmdUnsupportedMode (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode))
runQueryUTxO
:: AnyConsensusModeParams
-> QueryUTxOFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO :: AnyConsensusModeParams
-> QueryUTxOFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
QueryUTxOFilter
qfilter NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
Just EraInMode era mode
eInMode -> do
let query :: QueryInEra era (UTxO era)
query = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO QueryUTxOFilter
qfilter)
qInMode :: QueryInMode mode (Either EraMismatch (UTxO era))
qInMode = EraInMode era mode
-> QueryInEra era (UTxO era)
-> QueryInMode mode (Either EraMismatch (UTxO era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode QueryInEra era (UTxO era)
query
UTxO era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (UTxO era))
-> ExceptT ShelleyQueryCmdError IO (UTxO era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
CardanoEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode mode (Either EraMismatch (UTxO era))
qInMode
ShelleyBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT ShelleyQueryCmdError IO ()
forall era.
ShelleyBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT ShelleyQueryCmdError IO ()
writeFilteredUTxOs ShelleyBasedEra era
sbe Maybe OutputFile
mOutFile UTxO era
result
Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE
runQueryKesPeriodInfo
:: AnyConsensusModeParams
-> NetworkId
-> FilePath
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryKesPeriodInfo :: AnyConsensusModeParams
-> NetworkId
-> String
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryKesPeriodInfo (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network String
nodeOpCertFile
Maybe OutputFile
mOutFile = do
OperationalCertificate
opCert <- (FileError TextEnvelopeError -> ShelleyQueryCmdError)
-> ExceptT (FileError TextEnvelopeError) IO OperationalCertificate
-> ExceptT ShelleyQueryCmdError IO OperationalCertificate
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyQueryCmdError
ShelleyQueryCmdOpCertCounterReadError
(ExceptT (FileError TextEnvelopeError) IO OperationalCertificate
-> ExceptT ShelleyQueryCmdError IO OperationalCertificate)
-> (IO
(Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT (FileError TextEnvelopeError) IO OperationalCertificate)
-> IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT ShelleyQueryCmdError IO OperationalCertificate
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT (FileError TextEnvelopeError) IO OperationalCertificate
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT ShelleyQueryCmdError IO OperationalCertificate)
-> IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT ShelleyQueryCmdError IO OperationalCertificate
forall a b. (a -> b) -> a -> b
$ AsType OperationalCertificate
-> String
-> IO (Either (FileError TextEnvelopeError) OperationalCertificate)
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType OperationalCertificate
AsOperationalCertificate String
nodeOpCertFile
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
case ConsensusMode mode
cMode of
ConsensusMode mode
CardanoMode -> do
EraInMode era mode
eInMode <- CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode
Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE)
let genesisQinMode :: QueryInMode mode (Either EraMismatch GenesisParameters)
genesisQinMode = EraInMode era mode
-> QueryInEra era GenesisParameters
-> QueryInMode mode (Either EraMismatch GenesisParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era GenesisParameters
-> QueryInMode CardanoMode (Either EraMismatch GenesisParameters))
-> (QueryInShelleyBasedEra era GenesisParameters
-> QueryInEra era GenesisParameters)
-> QueryInShelleyBasedEra era GenesisParameters
-> QueryInMode CardanoMode (Either EraMismatch GenesisParameters)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era GenesisParameters
-> QueryInEra era GenesisParameters
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era GenesisParameters
-> QueryInMode mode (Either EraMismatch GenesisParameters))
-> QueryInShelleyBasedEra era GenesisParameters
-> QueryInMode mode (Either EraMismatch GenesisParameters)
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era GenesisParameters
forall era. QueryInShelleyBasedEra era GenesisParameters
QueryGenesisParameters
eraHistoryQuery :: QueryInMode CardanoMode (EraHistory CardanoMode)
eraHistoryQuery = ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode (EraHistory CardanoMode)
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
QueryEraHistory ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra
GenesisParameters
gParams <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch GenesisParameters)
-> ExceptT ShelleyQueryCmdError IO GenesisParameters
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch GenesisParameters)
genesisQinMode
ChainTip
chainTip <- IO ChainTip -> ExceptT ShelleyQueryCmdError IO ChainTip
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainTip -> ExceptT ShelleyQueryCmdError IO ChainTip)
-> IO ChainTip -> ExceptT ShelleyQueryCmdError IO ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode -> IO ChainTip
forall mode. LocalNodeConnectInfo mode -> IO ChainTip
getLocalChainTip LocalNodeConnectInfo mode
localNodeConnInfo
let curKesPeriod :: CurrentKesPeriod
curKesPeriod = ChainTip -> GenesisParameters -> CurrentKesPeriod
currentKesPeriod ChainTip
chainTip GenesisParameters
gParams
oCertStartKesPeriod :: OpCertStartingKesPeriod
oCertStartKesPeriod = OperationalCertificate -> OpCertStartingKesPeriod
opCertStartingKesPeriod OperationalCertificate
opCert
oCertEndKesPeriod :: OpCertEndingKesPeriod
oCertEndKesPeriod = GenesisParameters
-> OperationalCertificate -> OpCertEndingKesPeriod
opCertEndKesPeriod GenesisParameters
gParams OperationalCertificate
opCert
opCertIntervalInformation :: OpCertIntervalInformation
opCertIntervalInformation = GenesisParameters
-> ChainTip
-> CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> OpCertIntervalInformation
opCertIntervalInfo GenesisParameters
gParams ChainTip
chainTip CurrentKesPeriod
curKesPeriod OpCertStartingKesPeriod
oCertStartKesPeriod OpCertEndingKesPeriod
oCertEndKesPeriod
EraHistory CardanoMode
eraHistory <- (AcquireFailure -> ShelleyQueryCmdError)
-> ExceptT AcquireFailure IO (EraHistory CardanoMode)
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdError
ShelleyQueryCmdAcquireFailure (ExceptT AcquireFailure IO (EraHistory CardanoMode)
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode))
-> (IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT AcquireFailure IO (EraHistory CardanoMode))
-> IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT AcquireFailure IO (EraHistory CardanoMode)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode))
-> IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode (EraHistory CardanoMode)
-> IO (Either AcquireFailure (EraHistory CardanoMode))
forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquireFailure result)
queryNodeLocalState LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing QueryInMode mode (EraHistory CardanoMode)
QueryInMode CardanoMode (EraHistory CardanoMode)
eraHistoryQuery
let eInfo :: EpochInfo (Either Text)
eInfo = EraHistory CardanoMode -> EpochInfo (Either Text)
toEpochInfo EraHistory CardanoMode
eraHistory
let ptclStateQinMode :: QueryInMode mode (Either EraMismatch (ProtocolState era))
ptclStateQinMode = EraInMode era mode
-> QueryInEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (ProtocolState era)
-> QueryInMode
CardanoMode (Either EraMismatch (ProtocolState era)))
-> (QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era))
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode CardanoMode (Either EraMismatch (ProtocolState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era)))
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (ProtocolState era)
forall era. QueryInShelleyBasedEra era (ProtocolState era)
QueryProtocolState
ProtocolState era
ptclState <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
-> ExceptT ShelleyQueryCmdError IO (ProtocolState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch (ProtocolState era))
ptclStateQinMode
(OpCertOnDiskCounter
onDiskC, Maybe OpCertNodeStateCounter
stateC) <- ShelleyBasedEra era
-> ((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((ShelleyLedgerEra era ~ ledgerera,
Crypto ledgerera ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)), Era ledgerera,
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto ledgerera)) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
a)
-> a
eligibleLeaderSlotsConstaints ShelleyBasedEra era
sbe (((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a b. (a -> b) -> a -> b
$ ProtocolState era
-> OperationalCertificate
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall era.
(PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
ProtocolState era
-> OperationalCertificate
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
opCertOnDiskAndStateCounters ProtocolState era
ptclState OperationalCertificate
opCert
let counterInformation :: OpCertNodeAndOnDiskCounterInformation
counterInformation = OpCertOnDiskCounter
-> Maybe OpCertNodeStateCounter
-> OpCertNodeAndOnDiskCounterInformation
opCertNodeAndOnDiskCounters OpCertOnDiskCounter
onDiskC Maybe OpCertNodeStateCounter
stateC
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (String -> IO ())
-> String
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> ExceptT ShelleyQueryCmdError IO ())
-> String -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpCertIntervalInformation -> String
renderOpCertIntervalInformation String
nodeOpCertFile OpCertIntervalInformation
opCertIntervalInformation
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (String -> IO ())
-> String
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> ExceptT ShelleyQueryCmdError IO ())
-> String -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> OpCertNodeAndOnDiskCounterInformation -> String
renderOpCertNodeAndOnDiskCounterInformation String
nodeOpCertFile OpCertNodeAndOnDiskCounterInformation
counterInformation
let qKesInfoOutput :: QueryKesPeriodInfoOutput
qKesInfoOutput = OpCertIntervalInformation
-> OpCertNodeAndOnDiskCounterInformation
-> EpochInfo (Either Text)
-> GenesisParameters
-> QueryKesPeriodInfoOutput
createQueryKesPeriodInfoOutput OpCertIntervalInformation
opCertIntervalInformation OpCertNodeAndOnDiskCounterInformation
counterInformation EpochInfo (Either Text)
eInfo GenesisParameters
gParams
kesPeriodInfoJSON :: ByteString
kesPeriodInfoJSON = QueryKesPeriodInfoOutput -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty QueryKesPeriodInfoOutput
qKesInfoOutput
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn ByteString
kesPeriodInfoJSON
Maybe OutputFile
-> (OutputFile -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe OutputFile
mOutFile (\(OutputFile String
oFp) ->
(IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
oFp)
(IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
oFp ByteString
kesPeriodInfoJSON)
ConsensusMode mode
mode -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> (AnyConsensusMode -> ShelleyQueryCmdError)
-> AnyConsensusMode
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AnyConsensusMode -> ShelleyQueryCmdError
ShelleyQueryCmdUnsupportedMode (AnyConsensusMode -> ExceptT ShelleyQueryCmdError IO ())
-> AnyConsensusMode -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode
where
currentKesPeriod :: ChainTip -> GenesisParameters -> CurrentKesPeriod
currentKesPeriod :: ChainTip -> GenesisParameters -> CurrentKesPeriod
currentKesPeriod ChainTip
ChainTipAtGenesis GenesisParameters
_ = Word64 -> CurrentKesPeriod
CurrentKesPeriod Word64
0
currentKesPeriod (ChainTip SlotNo
currSlot Hash BlockHeader
_ BlockNo
_) GenesisParameters
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 -> Int
protocolParamSlotsPerKESPeriod GenesisParameters
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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64)
-> (OperationalCertificate -> Word)
-> OperationalCertificate
-> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OperationalCertificate -> Word
getKesPeriod
opCertEndKesPeriod :: GenesisParameters -> OperationalCertificate -> OpCertEndingKesPeriod
opCertEndKesPeriod :: GenesisParameters
-> OperationalCertificate -> OpCertEndingKesPeriod
opCertEndKesPeriod GenesisParameters
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 -> Int
protocolParamMaxKESEvolutions GenesisParameters
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
opCertIntervalInfo
:: GenesisParameters
-> ChainTip
-> CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> OpCertIntervalInformation
opCertIntervalInfo :: GenesisParameters
-> ChainTip
-> CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> OpCertIntervalInformation
opCertIntervalInfo GenesisParameters
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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 -> Int
protocolParamSlotsPerKESPeriod GenesisParameters
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
| Bool
otherwise = OpCertOnDiskCounter
-> OpCertNodeStateCounter -> OpCertNodeAndOnDiskCounterInformation
OpCertOnDiskCounterMoreThanOrEqualToNodeState OpCertOnDiskCounter
o OpCertNodeStateCounter
n
opCertNodeAndOnDiskCounters OpCertOnDiskCounter
o Maybe OpCertNodeStateCounter
Nothing = OpCertOnDiskCounter -> OpCertNodeAndOnDiskCounterInformation
OpCertNoBlocksMintedYet OpCertOnDiskCounter
o
opCertExpiryUtcTime
:: EpochInfo (Either Text)
-> GenesisParameters
-> OpCertEndingKesPeriod
-> Maybe UTCTime
opCertExpiryUtcTime :: EpochInfo (Either Text)
-> GenesisParameters -> OpCertEndingKesPeriod -> Maybe UTCTime
opCertExpiryUtcTime EpochInfo (Either Text)
eInfo GenesisParameters
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
EpochInfo (Either Text)
eInfo
(UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ GenesisParameters -> UTCTime
protocolParamSystemStart GenesisParameters
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 -> Int
protocolParamSlotsPerKESPeriod GenesisParameters
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 -> String
renderOpCertNodeAndOnDiskCounterInformation :: String -> OpCertNodeAndOnDiskCounterInformation -> String
renderOpCertNodeAndOnDiskCounterInformation String
opCertFile OpCertNodeAndOnDiskCounterInformation
opCertCounterInfo =
case OpCertNodeAndOnDiskCounterInformation
opCertCounterInfo of
OpCertOnDiskCounterMoreThanOrEqualToNodeState OpCertOnDiskCounter
_ OpCertNodeStateCounter
_ ->
String
"✓ The operational certificate counter agrees with the node protocol state counter"
OpCertOnDiskCounterBehindNodeState OpCertOnDiskCounter
onDiskC OpCertNodeStateCounter
nodeStateC ->
String
"✗ The protocol state counter is greater than the counter in the operational certificate at: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
opCertFile String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" On disk operational certificate counter: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (OpCertOnDiskCounter -> Word64
unOpCertOnDiskCounter OpCertOnDiskCounter
onDiskC) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Protocol state counter: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (OpCertNodeStateCounter -> Word64
unOpCertNodeStateCounter OpCertNodeStateCounter
nodeStateC)
OpCertNoBlocksMintedYet (OpCertOnDiskCounter Word64
onDiskC) ->
String
"✗ No blocks minted so far with the operational certificate at: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
opCertFile String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" On disk operational certificate counter: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
onDiskC
createQueryKesPeriodInfoOutput
:: OpCertIntervalInformation
-> OpCertNodeAndOnDiskCounterInformation
-> EpochInfo (Either Text)
-> GenesisParameters
-> O.QueryKesPeriodInfoOutput
createQueryKesPeriodInfoOutput :: OpCertIntervalInformation
-> OpCertNodeAndOnDiskCounterInformation
-> EpochInfo (Either Text)
-> GenesisParameters
-> QueryKesPeriodInfoOutput
createQueryKesPeriodInfoOutput OpCertIntervalInformation
oCertIntervalInfo OpCertNodeAndOnDiskCounterInformation
oCertCounterInfo EpochInfo (Either Text)
eInfo GenesisParameters
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
OpCertOnDiskCounterMoreThanOrEqualToNodeState 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 QueryKesPeriodInfoOutput :: OpCertIntervalInformation
-> Maybe UTCTime
-> Maybe OpCertNodeStateCounter
-> OpCertOnDiskCounter
-> Word64
-> Word64
-> QueryKesPeriodInfoOutput
O.QueryKesPeriodInfoOutput
{ $sel:qKesOpCertIntervalInformation:QueryKesPeriodInfoOutput :: OpCertIntervalInformation
O.qKesOpCertIntervalInformation = OpCertIntervalInformation
oCertIntervalInfo
, $sel:qKesInfoNodeStateOperationalCertNo:QueryKesPeriodInfoOutput :: Maybe OpCertNodeStateCounter
O.qKesInfoNodeStateOperationalCertNo = Maybe OpCertNodeStateCounter
mNodeCounter
, $sel:qKesInfoOnDiskOperationalCertNo:QueryKesPeriodInfoOutput :: OpCertOnDiskCounter
O.qKesInfoOnDiskOperationalCertNo = OpCertOnDiskCounter
onDiskCounter
, $sel:qKesInfoMaxKesKeyEvolutions:QueryKesPeriodInfoOutput :: 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 -> Int
protocolParamMaxKESEvolutions GenesisParameters
gParams
, $sel:qKesInfoSlotsPerKesPeriod:QueryKesPeriodInfoOutput :: 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 -> Int
protocolParamSlotsPerKESPeriod GenesisParameters
gParams
, $sel:qKesInfoKesKeyExpiry:QueryKesPeriodInfoOutput :: Maybe UTCTime
O.qKesInfoKesKeyExpiry =
case Maybe SlotsTillKesKeyExpiry
mStillExp of
Just SlotsTillKesKeyExpiry
_ -> EpochInfo (Either Text)
-> GenesisParameters -> OpCertEndingKesPeriod -> Maybe UTCTime
opCertExpiryUtcTime EpochInfo (Either Text)
eInfo GenesisParameters
gParams OpCertEndingKesPeriod
e
Maybe SlotsTillKesKeyExpiry
Nothing -> Maybe UTCTime
forall a. Maybe a
Nothing
}
opCertOnDiskAndStateCounters :: forall era . ()
=> Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
=> FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
=> Crypto.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
=> ProtocolState era
-> OperationalCertificate
-> ExceptT ShelleyQueryCmdError IO (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
opCertOnDiskAndStateCounters :: ProtocolState era
-> OperationalCertificate
-> ExceptT
ShelleyQueryCmdError
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
case 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 of
Left (ByteString, DecoderError)
decErr -> ShelleyQueryCmdError
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ShelleyQueryCmdError
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a b. (a -> b) -> a -> b
$ (ByteString, DecoderError) -> ShelleyQueryCmdError
ShelleyQueryCmdProtocolStateDecodeFailure (ByteString, DecoderError)
decErr
Right ChainDepState (ConsensusProtocol era)
chainDepState -> do
let opCertCounterMap :: Map
(KeyHash
'BlockIssuer
(PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)))
Word64
opCertCounterMap = Proxy (ConsensusProtocol era)
-> ChainDepState (ConsensusProtocol era)
-> Map
(KeyHash
'BlockIssuer
(PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)))
Word64
forall p (proxy :: * -> *).
PraosProtocolSupportsNode p =>
proxy p
-> ChainDepState p
-> Map
(KeyHash 'BlockIssuer (PraosProtocolSupportsNodeCrypto p)) Word64
Consensus.getOpCertCounters (Proxy (ConsensusProtocol era)
forall k (t :: k). Proxy t
Proxy @(ConsensusProtocol era)) ChainDepState (ConsensusProtocol era)
chainDepState
StakePoolKeyHash blockIssuerHash = VerificationKey StakePoolKey -> Hash StakePoolKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVKey
case KeyHash
'BlockIssuer
(PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
-> Map
(KeyHash
'BlockIssuer
(PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)))
Word64
-> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (KeyHash 'StakePool StandardCrypto
-> KeyHash
'BlockIssuer
(PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
coerce KeyHash 'StakePool StandardCrypto
blockIssuerHash) Map
(KeyHash
'BlockIssuer
(PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)))
Word64
opCertCounterMap of
Just Word64
ptclStateCounter -> (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
-> ExceptT
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
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
ShelleyQueryCmdError
IO
(OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> OpCertOnDiskCounter
OpCertOnDiskCounter Word64
onDiskOpCertCount, Maybe OpCertNodeStateCounter
forall a. Maybe a
Nothing)
renderOpCertIntervalInformation :: FilePath -> OpCertIntervalInformation -> String
renderOpCertIntervalInformation :: String -> OpCertIntervalInformation -> String
renderOpCertIntervalInformation String
_ (OpCertWithinInterval OpCertStartingKesPeriod
_start OpCertEndingKesPeriod
_end CurrentKesPeriod
_current SlotsTillKesKeyExpiry
_stillExp) =
String
"✓ Operational certificate's KES period is within the correct KES period interval"
renderOpCertIntervalInformation String
opCertFile
(OpCertStartingKesPeriodIsInTheFuture (OpCertStartingKesPeriod Word64
start)
(OpCertEndingKesPeriod Word64
end) (CurrentKesPeriod Word64
current)) =
String
"✗ Node operational certificate at: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
opCertFile String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" has an incorrectly specified starting KES period. " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Current KES period: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
current String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Operational certificate's starting KES period: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
start String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Operational certificate's expiry KES period: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
end
renderOpCertIntervalInformation String
opCertFile (OpCertExpired OpCertStartingKesPeriod
_ (OpCertEndingKesPeriod Word64
end) (CurrentKesPeriod Word64
current)) =
String
"✗ Node operational certificate at: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
opCertFile String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" has expired. " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Current KES period: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
current String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Operational certificate's expiry KES period: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
end
renderOpCertIntervalInformation String
opCertFile
(OpCertSomeOtherError (OpCertStartingKesPeriod Word64
start) (OpCertEndingKesPeriod Word64
end) (CurrentKesPeriod Word64
current)) =
String
"✗ An unknown error occurred with operational certificate at: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
opCertFile String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Current KES period: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
current String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Operational certificate's starting KES period: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
start String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
" Operational certificate's expiry KES period: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
end
runQueryPoolParams
:: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryPoolParams :: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryPoolParams (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Hash StakePoolKey
poolid = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
EraInMode era mode
eInMode <- CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode
Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE)
let qInMode :: QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode = EraInMode era mode
-> QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
SerialisedDebugLedgerState era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT ShelleyQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
ShelleyBasedEra era
-> ((UsesValue (ShelleyLedgerEra era),
ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
ToJSON (PParams (ShelleyLedgerEra era))) =>
SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((UsesValue ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era), Crypto ledgerera ~ StandardCrypto,
ToJSON (PParams ledgerera)) =>
a)
-> a
obtainLedgerEraClassConstraints ShelleyBasedEra era
sbe (Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera, FromCBOR (DebugLedgerState era),
Crypto (Crypto ledgerera), Crypto ledgerera ~ StandardCrypto) =>
Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writePoolParams Hash StakePoolKey
poolid) SerialisedDebugLedgerState era
result
runQueryStakeSnapshot
:: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeSnapshot :: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeSnapshot (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Hash StakePoolKey
poolid = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
EraInMode era mode
eInMode <- CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode
Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE)
let qInMode :: QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode = EraInMode era mode
-> QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
SerialisedDebugLedgerState era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT ShelleyQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
ShelleyBasedEra era
-> ((UsesValue (ShelleyLedgerEra era),
ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
ToJSON (PParams (ShelleyLedgerEra era))) =>
SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((UsesValue ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era), Crypto ledgerera ~ StandardCrypto,
ToJSON (PParams ledgerera)) =>
a)
-> a
obtainLedgerEraClassConstraints ShelleyBasedEra era
sbe (Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
Crypto ledgerera ~ StandardCrypto,
FromCBOR (DebugLedgerState era)) =>
Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeSnapshot Hash StakePoolKey
poolid) SerialisedDebugLedgerState era
result
runQueryLedgerState
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
Just EraInMode era mode
eInMode -> do
let qInMode :: QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode = EraInMode era mode
-> QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
(QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
(QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
SerialisedDebugLedgerState era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT ShelleyQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
CardanoEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
ShelleyBasedEra era
-> ((UsesValue (ShelleyLedgerEra era),
ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
ToJSON (PParams (ShelleyLedgerEra era))) =>
SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((UsesValue ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era), Crypto ledgerera ~ StandardCrypto,
ToJSON (PParams ledgerera)) =>
a)
-> a
obtainLedgerEraClassConstraints ShelleyBasedEra era
sbe (Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era)) =>
Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeLedgerState Maybe OutputFile
mOutFile) SerialisedDebugLedgerState era
result
Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE
runQueryProtocolState
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolState :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolState (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
Just EraInMode era mode
eInMode -> do
let qInMode :: QueryInMode mode (Either EraMismatch (ProtocolState era))
qInMode = EraInMode era mode
-> QueryInEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
(QueryInEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era)))
-> (QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era))
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
(QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era)))
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (ProtocolState era)
forall era. QueryInShelleyBasedEra era (ProtocolState era)
QueryProtocolState
ProtocolState era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
-> ExceptT ShelleyQueryCmdError IO (ProtocolState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
CardanoEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode mode (Either EraMismatch (ProtocolState era))
qInMode
case ConsensusMode mode
cMode of
ConsensusMode mode
CardanoMode -> ShelleyBasedEra era
-> ((FromCBOR (ChainDepState (ConsensusProtocol era)),
ToJSON (ChainDepState (ConsensusProtocol era))) =>
ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO ()
forall era a.
ShelleyBasedEra era
-> ((FromCBOR (ChainDepState (ConsensusProtocol era)),
ToJSON (ChainDepState (ConsensusProtocol era))) =>
a)
-> a
eligibleWriteProtocolStateConstaints ShelleyBasedEra era
sbe (((FromCBOR (ChainDepState (ConsensusProtocol era)),
ToJSON (ChainDepState (ConsensusProtocol era))) =>
ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO ())
-> ((FromCBOR (ChainDepState (ConsensusProtocol era)),
ToJSON (ChainDepState (ConsensusProtocol era))) =>
ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe OutputFile
-> ProtocolState era -> ExceptT ShelleyQueryCmdError IO ()
forall era.
(FromCBOR (ChainDepState (ConsensusProtocol era)),
ToJSON (ChainDepState (ConsensusProtocol era))) =>
Maybe OutputFile
-> ProtocolState era -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolState Maybe OutputFile
mOutFile ProtocolState era
result
ConsensusMode mode
mode -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> (AnyConsensusMode -> ShelleyQueryCmdError)
-> AnyConsensusMode
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AnyConsensusMode -> ShelleyQueryCmdError
ShelleyQueryCmdUnsupportedMode (AnyConsensusMode -> ExceptT ShelleyQueryCmdError IO ())
-> AnyConsensusMode -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode
Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE
runQueryStakeAddressInfo
:: AnyConsensusModeParams
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo :: AnyConsensusModeParams
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
(StakeAddress Network
_ Credential 'Staking StandardCrypto
addr) NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
Just EraInMode era mode
eInMode -> do
let stakeAddr :: Set StakeCredential
stakeAddr = StakeCredential -> Set StakeCredential
forall a. a -> Set a
Set.singleton (StakeCredential -> Set StakeCredential)
-> StakeCredential -> Set StakeCredential
forall a b. (a -> b) -> a -> b
$ Credential 'Staking StandardCrypto -> StakeCredential
fromShelleyStakeCredential Credential 'Staking StandardCrypto
addr
query :: QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
query = EraInMode era mode
-> QueryInEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
(QueryInEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))))
-> (QueryInShelleyBasedEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
-> QueryInShelleyBasedEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
(QueryInShelleyBasedEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))))
-> QueryInShelleyBasedEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
forall a b. (a -> b) -> a -> b
$ Set StakeCredential
-> NetworkId
-> QueryInShelleyBasedEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
forall era.
Set StakeCredential
-> NetworkId
-> QueryInShelleyBasedEra
era
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
QueryStakeAddresses Set StakeCredential
stakeAddr NetworkId
network
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
-> ExceptT
ShelleyQueryCmdError
IO
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
CardanoEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
query
Maybe OutputFile
-> DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo Maybe OutputFile
mOutFile (DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ())
-> DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> DelegationsAndRewards
DelegationsAndRewards (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
result
Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE
data ShelleyQueryCmdLocalStateQueryError
= AcquireFailureError !LocalStateQuery.AcquireFailure
| EraMismatchError !EraMismatch
| ByronProtocolNotSupportedError
| ShelleyProtocolEraMismatch
deriving (ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
(ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool)
-> (ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool)
-> Eq ShelleyQueryCmdLocalStateQueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
$c/= :: ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
== :: ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
$c== :: ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
Eq, Int -> ShelleyQueryCmdLocalStateQueryError -> ShowS
[ShelleyQueryCmdLocalStateQueryError] -> ShowS
ShelleyQueryCmdLocalStateQueryError -> String
(Int -> ShelleyQueryCmdLocalStateQueryError -> ShowS)
-> (ShelleyQueryCmdLocalStateQueryError -> String)
-> ([ShelleyQueryCmdLocalStateQueryError] -> ShowS)
-> Show ShelleyQueryCmdLocalStateQueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyQueryCmdLocalStateQueryError] -> ShowS
$cshowList :: [ShelleyQueryCmdLocalStateQueryError] -> ShowS
show :: ShelleyQueryCmdLocalStateQueryError -> String
$cshow :: ShelleyQueryCmdLocalStateQueryError -> String
showsPrec :: Int -> ShelleyQueryCmdLocalStateQueryError -> ShowS
$cshowsPrec :: Int -> ShelleyQueryCmdLocalStateQueryError -> ShowS
Show)
renderLocalStateQueryError :: ShelleyQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError :: ShelleyQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
lsqErr =
case ShelleyQueryCmdLocalStateQueryError
lsqErr of
AcquireFailureError AcquireFailure
err -> Text
"Local state query acquire failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AcquireFailure -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show AcquireFailure
err
EraMismatchError EraMismatch
err ->
Text
"A query from a certain era was applied to a ledger from a different era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EraMismatch -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show EraMismatch
err
ShelleyQueryCmdLocalStateQueryError
ByronProtocolNotSupportedError ->
Text
"The attempted local state query does not support the Byron protocol."
ShelleyQueryCmdLocalStateQueryError
ShelleyProtocolEraMismatch ->
Text
"The Shelley protocol mode can only be used with the Shelley era, "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"i.e. with --shelley-mode use --shelley-era flag"
writeStakeAddressInfo
:: Maybe OutputFile
-> DelegationsAndRewards
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo :: Maybe OutputFile
-> DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo Maybe OutputFile
mOutFile DelegationsAndRewards
delegsAndRewards =
case Maybe OutputFile
mOutFile of
Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (DelegationsAndRewards -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty DelegationsAndRewards
delegsAndRewards)
Just (OutputFile String
fpath) ->
(IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
(IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (DelegationsAndRewards -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty DelegationsAndRewards
delegsAndRewards)
writeLedgerState :: forall era ledgerera.
ShelleyLedgerEra era ~ ledgerera
=> ToJSON (DebugLedgerState era)
=> FromCBOR (DebugLedgerState era)
=> Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeLedgerState :: Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeLedgerState Maybe OutputFile
mOutFile qState :: SerialisedDebugLedgerState era
qState@(SerialisedDebugLedgerState Serialised (NewEpochState (ShelleyLedgerEra era))
serLedgerState) =
case Maybe OutputFile
mOutFile of
Maybe OutputFile
Nothing -> case SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
decodeDebugLedgerState SerialisedDebugLedgerState era
qState of
Left ByteString
bs -> (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
Right DebugLedgerState era
ledgerState -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ DebugLedgerState era -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty DebugLedgerState era
ledgerState
Just (OutputFile String
fpath) ->
(IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
(IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Serialised (NewEpochState ledgerera) -> ByteString
forall a. Serialised a -> ByteString
unSerialised Serialised (NewEpochState ledgerera)
Serialised (NewEpochState (ShelleyLedgerEra era))
serLedgerState
writeStakeSnapshot :: forall era ledgerera. ()
=> ShelleyLedgerEra era ~ ledgerera
=> Era.Crypto ledgerera ~ StandardCrypto
=> FromCBOR (DebugLedgerState era)
=> PoolId
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeSnapshot :: Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeSnapshot (StakePoolKeyHash hk) SerialisedDebugLedgerState era
qState =
case SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
decodeDebugLedgerState SerialisedDebugLedgerState era
qState of
Left ByteString
bs -> (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
Right DebugLedgerState era
ledgerState -> do
let (DebugLedgerState NewEpochState ledgerera
snapshot) = DebugLedgerState era
ledgerState
let (SnapShots SnapShot StandardCrypto
markS SnapShot StandardCrypto
setS SnapShot StandardCrypto
goS Coin
_) = EpochState ledgerera -> SnapShots (Crypto ledgerera)
forall era. EpochState era -> SnapShots (Crypto era)
esSnapshots (EpochState ledgerera -> SnapShots (Crypto ledgerera))
-> EpochState ledgerera -> SnapShots (Crypto ledgerera)
forall a b. (a -> b) -> a -> b
$ NewEpochState ledgerera -> EpochState ledgerera
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState ledgerera
snapshot
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Stakes -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Stakes -> ByteString) -> Stakes -> ByteString
forall a b. (a -> b) -> a -> b
$ Stakes :: Integer
-> Integer -> Integer -> Integer -> Integer -> Integer -> Stakes
Stakes
{ markPool :: Integer
markPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
markS
, setPool :: Integer
setPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
setS
, goPool :: Integer
goPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
goS
, markTotal :: Integer
markTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
markS
, setTotal :: Integer
setTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
setS
, goTotal :: Integer
goTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
goS
}
getPoolStake :: KeyHash Cardano.Ledger.Keys.StakePool crypto -> SnapShot crypto -> Integer
getPoolStake :: KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool crypto
hash SnapShot crypto
ss = Integer
pStake
where
Coin Integer
pStake = Map (Credential 'Staking crypto) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ((CompactForm Coin -> Coin)
-> Map (Credential 'Staking crypto) (CompactForm Coin)
-> Map (Credential 'Staking crypto) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (Map (Credential 'Staking crypto) (CompactForm Coin)
-> Map (Credential 'Staking crypto) Coin)
-> Map (Credential 'Staking crypto) (CompactForm Coin)
-> Map (Credential 'Staking crypto) Coin
forall a b. (a -> b) -> a -> b
$ VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Map (Credential 'Staking crypto) (CompactForm Coin)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
s)
Stake VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
s = KeyHash 'StakePool crypto
-> VMap
VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
forall crypto.
KeyHash 'StakePool crypto
-> VMap
VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
poolStake KeyHash 'StakePool crypto
hash (SnapShot crypto
-> VMap
VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
forall crypto.
SnapShot crypto
-> VMap
VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations SnapShot crypto
ss) (SnapShot crypto -> Stake crypto
forall crypto. SnapShot crypto -> Stake crypto
_stake SnapShot crypto
ss)
getAllStake :: SnapShot crypto -> Integer
getAllStake :: SnapShot crypto -> Integer
getAllStake (SnapShot Stake crypto
stake VMap VB VB (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_ VMap VB VB (KeyHash 'StakePool crypto) (PoolParams crypto)
_) = Integer
activeStake
where
Coin Integer
activeStake = Map (Credential 'Staking crypto) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ((CompactForm Coin -> Coin)
-> Map (Credential 'Staking crypto) (CompactForm Coin)
-> Map (Credential 'Staking crypto) Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
-> Map (Credential 'Staking crypto) (CompactForm Coin)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
forall crypto.
Stake crypto
-> VMap VB VP (Credential 'Staking crypto) (CompactForm Coin)
unStake Stake crypto
stake)))
writePoolParams :: forall era ledgerera. ()
=> ShelleyLedgerEra era ~ ledgerera
=> FromCBOR (DebugLedgerState era)
=> Crypto.Crypto (Era.Crypto ledgerera)
=> Era.Crypto ledgerera ~ StandardCrypto
=> PoolId
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writePoolParams :: Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writePoolParams (StakePoolKeyHash hk) SerialisedDebugLedgerState era
qState =
case SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
decodeDebugLedgerState SerialisedDebugLedgerState era
qState of
Left ByteString
bs -> (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
Right DebugLedgerState era
ledgerState -> do
let DebugLedgerState NewEpochState ledgerera
snapshot = DebugLedgerState era
ledgerState
let poolState :: PState StandardCrypto
poolState :: PState StandardCrypto
poolState = DPState StandardCrypto -> PState StandardCrypto
forall crypto. DPState crypto -> PState crypto
dpsPState (DPState StandardCrypto -> PState StandardCrypto)
-> (LedgerState ledgerera -> DPState StandardCrypto)
-> LedgerState ledgerera
-> PState StandardCrypto
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LedgerState ledgerera -> DPState StandardCrypto
forall era. LedgerState era -> DPState (Crypto era)
lsDPState (LedgerState ledgerera -> PState StandardCrypto)
-> LedgerState ledgerera -> PState StandardCrypto
forall a b. (a -> b) -> a -> b
$ EpochState ledgerera -> LedgerState ledgerera
forall era. EpochState era -> LedgerState era
esLState (EpochState ledgerera -> LedgerState ledgerera)
-> EpochState ledgerera -> LedgerState ledgerera
forall a b. (a -> b) -> a -> b
$ NewEpochState ledgerera -> EpochState ledgerera
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState ledgerera
snapshot
let poolParams :: Maybe (PoolParams StandardCrypto)
poolParams = KeyHash 'StakePool StandardCrypto
-> Map
(KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool StandardCrypto
hk (Map
(KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto))
-> Map
(KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
forall a b. (a -> b) -> a -> b
$ PState StandardCrypto
-> Map
(KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
forall crypto.
PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_pParams PState StandardCrypto
poolState
let fPoolParams :: Maybe (PoolParams StandardCrypto)
fPoolParams = KeyHash 'StakePool StandardCrypto
-> Map
(KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool StandardCrypto
hk (Map
(KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto))
-> Map
(KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
forall a b. (a -> b) -> a -> b
$ PState StandardCrypto
-> Map
(KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
forall crypto.
PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_fPParams PState StandardCrypto
poolState
let retiring :: Maybe EpochNo
retiring = KeyHash 'StakePool StandardCrypto
-> Map (KeyHash 'StakePool StandardCrypto) EpochNo -> Maybe EpochNo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool StandardCrypto
hk (Map (KeyHash 'StakePool StandardCrypto) EpochNo -> Maybe EpochNo)
-> Map (KeyHash 'StakePool StandardCrypto) EpochNo -> Maybe EpochNo
forall a b. (a -> b) -> a -> b
$ PState StandardCrypto
-> Map (KeyHash 'StakePool StandardCrypto) EpochNo
forall crypto.
PState crypto -> Map (KeyHash 'StakePool crypto) EpochNo
_retiring PState StandardCrypto
poolState
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Params StandardCrypto -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Params StandardCrypto -> ByteString)
-> Params StandardCrypto -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
-> Maybe EpochNo
-> Params StandardCrypto
forall crypto.
Maybe (PoolParams crypto)
-> Maybe (PoolParams crypto) -> Maybe EpochNo -> Params crypto
Params Maybe (PoolParams StandardCrypto)
poolParams Maybe (PoolParams StandardCrypto)
fPoolParams Maybe EpochNo
retiring
writeProtocolState ::
( FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
)
=> Maybe OutputFile
-> ProtocolState era
-> ExceptT ShelleyQueryCmdError IO ()
writeProtocolState :: Maybe OutputFile
-> ProtocolState era -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolState Maybe OutputFile
mOutFile ps :: ProtocolState era
ps@(ProtocolState Serialised (ChainDepState (ConsensusProtocol era))
pstate) =
case Maybe OutputFile
mOutFile of
Maybe OutputFile
Nothing -> case 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 of
Left (ByteString
bs, DecoderError
_) -> (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
Right ChainDepState (ConsensusProtocol era)
chainDepstate -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ChainDepState (ConsensusProtocol era) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ChainDepState (ConsensusProtocol era)
chainDepstate
Just (OutputFile String
fpath) ->
(IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
(IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString -> IO ()
LBS.writeFile String
fpath (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Serialised (ChainDepState (ConsensusProtocol era)) -> ByteString
forall a. Serialised a -> ByteString
unSerialised Serialised (ChainDepState (ConsensusProtocol era))
pstate
writeFilteredUTxOs :: Api.ShelleyBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT ShelleyQueryCmdError IO ()
writeFilteredUTxOs :: ShelleyBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT ShelleyQueryCmdError IO ()
writeFilteredUTxOs ShelleyBasedEra era
shelleyBasedEra' Maybe OutputFile
mOutFile UTxO era
utxo =
case Maybe OutputFile
mOutFile of
Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> UTxO era -> IO ()
forall era. ShelleyBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs ShelleyBasedEra era
shelleyBasedEra' UTxO era
utxo
Just (OutputFile String
fpath) ->
case ShelleyBasedEra era
shelleyBasedEra' of
ShelleyBasedEra era
ShelleyBasedEraShelley -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
ShelleyBasedEra era
ShelleyBasedEraAllegra -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
ShelleyBasedEra era
ShelleyBasedEraMary -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
ShelleyBasedEra era
ShelleyBasedEraAlonzo -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
ShelleyBasedEra era
ShelleyBasedEraBabbage -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
where
writeUTxo :: String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath a
utxo' =
(IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
(IO () -> ExceptT ShelleyQueryCmdError m ())
-> IO () -> ExceptT ShelleyQueryCmdError m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (a -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty a
utxo')
printFilteredUTxOs :: Api.ShelleyBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs :: ShelleyBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs ShelleyBasedEra era
shelleyBasedEra' (UTxO Map TxIn (TxOut CtxUTxO era)
utxo) = do
Text -> IO ()
Text.putStrLn Text
title
String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
'-'
case ShelleyBasedEra era
shelleyBasedEra' of
ShelleyBasedEra era
ShelleyBasedEraShelley ->
((TxIn, TxOut CtxUTxO era) -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
forall era.
ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut CtxUTxO era)] -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO era) -> [(TxIn, TxOut CtxUTxO era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut CtxUTxO era)
utxo
ShelleyBasedEra era
ShelleyBasedEraAllegra ->
((TxIn, TxOut CtxUTxO era) -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
forall era.
ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut CtxUTxO era)] -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO era) -> [(TxIn, TxOut CtxUTxO era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut CtxUTxO era)
utxo
ShelleyBasedEra era
ShelleyBasedEraMary ->
((TxIn, TxOut CtxUTxO era) -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
forall era.
ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut CtxUTxO era)] -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO era) -> [(TxIn, TxOut CtxUTxO era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut CtxUTxO era)
utxo
ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
((TxIn, TxOut CtxUTxO era) -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
forall era.
ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut CtxUTxO era)] -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO era) -> [(TxIn, TxOut CtxUTxO era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut CtxUTxO era)
utxo
ShelleyBasedEra era
ShelleyBasedEraBabbage ->
((TxIn, TxOut CtxUTxO era) -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
forall era.
ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut CtxUTxO era)] -> IO ())
-> [(TxIn, TxOut CtxUTxO era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO era) -> [(TxIn, TxOut CtxUTxO era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut CtxUTxO era)
utxo
where
title :: Text
title :: Text
title =
Text
" TxHash TxIx Amount"
printUtxo
:: Api.ShelleyBasedEra era
-> (TxIn, TxOut CtxUTxO era)
-> IO ()
printUtxo :: ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra' (TxIn, TxOut CtxUTxO era)
txInOutTuple =
case ShelleyBasedEra era
shelleyBasedEra' of
ShelleyBasedEra era
ShelleyBasedEraShelley ->
let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatum CtxUTxO era
_ ReferenceScript era
_) = (TxIn, TxOut CtxUTxO era)
txInOutTuple
in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 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
]
ShelleyBasedEra era
ShelleyBasedEraAllegra ->
let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatum CtxUTxO era
_ ReferenceScript era
_) = (TxIn, TxOut CtxUTxO era)
txInOutTuple
in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 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
]
ShelleyBasedEra era
ShelleyBasedEraMary ->
let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatum CtxUTxO era
_ ReferenceScript era
_) = (TxIn, TxOut CtxUTxO era)
txInOutTuple
in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 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
]
ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatum CtxUTxO era
mDatum ReferenceScript era
_) = (TxIn, TxOut CtxUTxO era)
txInOutTuple
in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 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
<> String -> Text
Text.pack (TxOutDatum CtxUTxO era -> String
forall a b. (Show a, ConvertText String b) => a -> b
show TxOutDatum CtxUTxO era
mDatum)
]
ShelleyBasedEra era
ShelleyBasedEraBabbage ->
let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatum CtxUTxO era
mDatum ReferenceScript era
_) = (TxIn, TxOut CtxUTxO era)
txInOutTuple
in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 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
<> String -> Text
Text.pack (TxOutDatum CtxUTxO era -> String
forall a b. (Show a, ConvertText String b) => a -> b
show TxOutDatum CtxUTxO era
mDatum)
]
where
textShowN :: Show a => Int -> a -> Text
textShowN :: Int -> a -> Text
textShowN Int
len a
x =
let str :: String
str = a -> String
forall a b. (Show a, ConvertText String b) => a -> b
show a
x
slen :: Int
slen = String -> Int
forall a. HasLength a => a -> Int
length String
str
in String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
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
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
printableValue :: TxOutValue era -> Text
printableValue :: TxOutValue era -> Text
printableValue (TxOutValue MultiAssetSupportedInEra era
_ Value
val) = Value -> Text
renderValue Value
val
printableValue (TxOutAdaOnly OnlyAdaSupportedInEra era
_ (Lovelace Integer
i)) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Integer
i
runQueryStakePools
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakePools :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakePools (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
Set (Hash StakePoolKey)
result <- IO (Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> ExceptT ShelleyQueryCmdError IO (Set (Hash StakePoolKey))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> ExceptT ShelleyQueryCmdError IO (Set (Hash StakePoolKey)))
-> (IO
(Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> IO (Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> IO
(Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> ExceptT ShelleyQueryCmdError IO (Set (Hash StakePoolKey))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> IO
(Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> IO (Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either
ShelleyQueryCmdError
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> Either ShelleyQueryCmdError (Set (Hash StakePoolKey))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either
ShelleyQueryCmdError
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> (Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> Either
ShelleyQueryCmdError
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> Either ShelleyQueryCmdError (Set (Hash StakePoolKey))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (AcquireFailure -> ShelleyQueryCmdError)
-> Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
-> Either
ShelleyQueryCmdError
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquireFailure -> ShelleyQueryCmdError
ShelleyQueryCmdAcquireFailure) (IO
(Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> ExceptT ShelleyQueryCmdError IO (Set (Hash StakePoolKey)))
-> IO
(Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> ExceptT ShelleyQueryCmdError IO (Set (Hash StakePoolKey))
forall a b. (a -> b) -> a -> b
$
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> IO
(Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
forall mode a.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (Either AcquireFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing ((NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> IO
(Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))))
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> IO
(Either
AcquireFailure
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
_ntcVersion -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
forall (m :: * -> *) a.
ExceptT ShelleyQueryCmdError m a
-> m (Either ShelleyQueryCmdError a)
runExceptT @ShelleyQueryCmdError (ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey))))
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either ShelleyQueryCmdError (Set (Hash StakePoolKey)))
forall a b. (a -> b) -> a -> b
$ do
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- case ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams of
ConsensusMode mode
ByronMode -> AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra)
-> AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
ConsensusMode mode
ShelleyMode -> AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra)
-> AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
ConsensusMode mode
CardanoMode -> LocalStateQueryExpr
(BlockInMode CardanoMode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode CardanoMode)
ChainPoint
(QueryInMode CardanoMode)
()
IO)
AnyCardanoEra
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalStateQueryExpr
(BlockInMode CardanoMode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode CardanoMode)
ChainPoint
(QueryInMode CardanoMode)
()
IO)
AnyCardanoEra)
-> (QueryInMode CardanoMode AnyCardanoEra
-> LocalStateQueryExpr
(BlockInMode CardanoMode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
AnyCardanoEra)
-> QueryInMode CardanoMode AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode CardanoMode)
ChainPoint
(QueryInMode CardanoMode)
()
IO)
AnyCardanoEra
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryInMode CardanoMode AnyCardanoEra
-> LocalStateQueryExpr
(BlockInMode CardanoMode)
ChainPoint
(QueryInMode CardanoMode)
()
IO
AnyCardanoEra
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode CardanoMode AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra)
-> QueryInMode CardanoMode AnyCardanoEra
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode AnyCardanoEra
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode AnyCardanoEra
QueryCurrentEra ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
Just EraInMode era mode
eInMode -> do
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
(EraMismatch -> ShelleyQueryCmdError)
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> ShelleyQueryCmdError
ShelleyQueryCmdEraMismatch (ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey)))
-> (LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey)))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey)))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall a b. (a -> b) -> a -> b
$
QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey)))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey)))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey))))
-> (QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
-> QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey))))
-> QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EraInMode era mode
-> QueryInEra era (Set (Hash StakePoolKey))
-> QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey)))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (Set (Hash StakePoolKey))
-> QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey))))
-> (QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
-> QueryInEra era (Set (Hash StakePoolKey)))
-> QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
-> QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
-> QueryInEra era (Set (Hash StakePoolKey))
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey))))
-> QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
forall era. QueryInShelleyBasedEra era (Set (Hash StakePoolKey))
QueryStakePools
Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey)))
-> ShelleyQueryCmdError
-> ExceptT
ShelleyQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE
Maybe OutputFile
-> Set (Hash StakePoolKey) -> ExceptT ShelleyQueryCmdError IO ()
writeStakePools Maybe OutputFile
mOutFile Set (Hash StakePoolKey)
result
writeStakePools
:: Maybe OutputFile
-> Set PoolId
-> ExceptT ShelleyQueryCmdError IO ()
writeStakePools :: Maybe OutputFile
-> Set (Hash StakePoolKey) -> ExceptT ShelleyQueryCmdError IO ()
writeStakePools (Just (OutputFile String
outFile)) Set (Hash StakePoolKey)
stakePools =
(IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
outFile) (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
String -> ByteString -> IO ()
LBS.writeFile String
outFile (Set (Hash StakePoolKey) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Set (Hash StakePoolKey)
stakePools)
writeStakePools Maybe OutputFile
Nothing Set (Hash StakePoolKey)
stakePools =
[Hash StakePoolKey]
-> (Hash StakePoolKey -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Set (Hash StakePoolKey) -> [Hash StakePoolKey]
forall a. Set a -> [a]
Set.toList Set (Hash StakePoolKey)
stakePools) ((Hash StakePoolKey -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO ())
-> (Hash StakePoolKey -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \Hash StakePoolKey
poolId ->
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (String -> IO ())
-> String
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> ExceptT ShelleyQueryCmdError IO ())
-> String -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Hash StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Hash StakePoolKey
poolId)
runQueryStakeDistribution
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
Just EraInMode era mode
eInMode -> do
let query :: QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
query = EraInMode era mode
-> QueryInEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
(QueryInEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational)))
-> (QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInEra era (Map (Hash StakePoolKey) Rational))
-> QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInEra era (Map (Hash StakePoolKey) Rational)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
(QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational)))
-> QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
forall era.
QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
QueryStakeDistribution
Map (Hash StakePoolKey) Rational
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
-> ExceptT
ShelleyQueryCmdError IO (Map (Hash StakePoolKey) Rational)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
CardanoEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
query
Maybe OutputFile
-> Map (Hash StakePoolKey) Rational
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution Maybe OutputFile
mOutFile Map (Hash StakePoolKey) Rational
result
Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE
writeStakeDistribution
:: Maybe OutputFile
-> Map PoolId Rational
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution :: Maybe OutputFile
-> Map (Hash StakePoolKey) Rational
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution (Just (OutputFile String
outFile)) Map (Hash StakePoolKey) Rational
stakeDistrib =
(IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
outFile) (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
String -> ByteString -> IO ()
LBS.writeFile String
outFile (Map (Hash StakePoolKey) Rational -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map (Hash StakePoolKey) Rational
stakeDistrib)
writeStakeDistribution Maybe OutputFile
Nothing Map (Hash StakePoolKey) Rational
stakeDistrib =
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Map (Hash StakePoolKey) Rational -> IO ()
printStakeDistribution Map (Hash StakePoolKey) Rational
stakeDistrib
printStakeDistribution :: Map PoolId Rational -> IO ()
printStakeDistribution :: Map (Hash StakePoolKey) Rational -> IO ()
printStakeDistribution Map (Hash StakePoolKey) Rational
stakeDistrib = do
Text -> IO ()
Text.putStrLn Text
title
String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
'-'
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Hash StakePoolKey -> Rational -> String
showStakeDistr Hash StakePoolKey
poolId Rational
stakeFraction
| (Hash StakePoolKey
poolId, Rational
stakeFraction) <- Map (Hash StakePoolKey) Rational -> [(Hash StakePoolKey, Rational)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Hash StakePoolKey) Rational
stakeDistrib ]
where
title :: Text
title :: Text
title =
Text
" PoolId Stake frac"
showStakeDistr :: PoolId
-> Rational
-> String
showStakeDistr :: Hash StakePoolKey -> Rational -> String
showStakeDistr Hash StakePoolKey
poolId Rational
stakeFraction =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ Text -> String
Text.unpack (Hash StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Hash StakePoolKey
poolId)
, String
" "
, Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
stakeFraction :: Double) String
""
]
newtype DelegationsAndRewards
= DelegationsAndRewards (Map StakeAddress Lovelace, Map StakeAddress PoolId)
deriving (DelegationsAndRewards -> DelegationsAndRewards -> Bool
(DelegationsAndRewards -> DelegationsAndRewards -> Bool)
-> (DelegationsAndRewards -> DelegationsAndRewards -> Bool)
-> Eq DelegationsAndRewards
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DelegationsAndRewards -> DelegationsAndRewards -> Bool
$c/= :: DelegationsAndRewards -> DelegationsAndRewards -> Bool
== :: DelegationsAndRewards -> DelegationsAndRewards -> Bool
$c== :: DelegationsAndRewards -> DelegationsAndRewards -> Bool
Eq, Int -> DelegationsAndRewards -> ShowS
[DelegationsAndRewards] -> ShowS
DelegationsAndRewards -> String
(Int -> DelegationsAndRewards -> ShowS)
-> (DelegationsAndRewards -> String)
-> ([DelegationsAndRewards] -> ShowS)
-> Show DelegationsAndRewards
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelegationsAndRewards] -> ShowS
$cshowList :: [DelegationsAndRewards] -> ShowS
show :: DelegationsAndRewards -> String
$cshow :: DelegationsAndRewards -> String
showsPrec :: Int -> DelegationsAndRewards -> ShowS
$cshowsPrec :: Int -> DelegationsAndRewards -> ShowS
Show)
mergeDelegsAndRewards :: DelegationsAndRewards -> [(StakeAddress, Maybe Lovelace, Maybe PoolId)]
mergeDelegsAndRewards :: DelegationsAndRewards
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
mergeDelegsAndRewards (DelegationsAndRewards (Map StakeAddress Lovelace
rewardsMap, Map StakeAddress (Hash StakePoolKey)
delegMap)) =
[ (StakeAddress
stakeAddr, StakeAddress -> Map StakeAddress Lovelace -> Maybe Lovelace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
stakeAddr Map StakeAddress Lovelace
rewardsMap, StakeAddress
-> Map StakeAddress (Hash StakePoolKey)
-> Maybe (Hash StakePoolKey)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
stakeAddr Map StakeAddress (Hash StakePoolKey)
delegMap)
| StakeAddress
stakeAddr <- [StakeAddress] -> [StakeAddress]
forall a. Eq a => [a] -> [a]
nub ([StakeAddress] -> [StakeAddress])
-> [StakeAddress] -> [StakeAddress]
forall a b. (a -> b) -> a -> b
$ Map StakeAddress Lovelace -> [StakeAddress]
forall k a. Map k a -> [k]
Map.keys Map StakeAddress Lovelace
rewardsMap [StakeAddress] -> [StakeAddress] -> [StakeAddress]
forall a. [a] -> [a] -> [a]
++ Map StakeAddress (Hash StakePoolKey) -> [StakeAddress]
forall k a. Map k a -> [k]
Map.keys Map StakeAddress (Hash StakePoolKey)
delegMap
]
instance ToJSON DelegationsAndRewards where
toJSON :: DelegationsAndRewards -> Value
toJSON DelegationsAndRewards
delegsAndRwds =
Array -> Value
Aeson.Array (Array -> Value)
-> ([(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> Array)
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList
([Value] -> Array)
-> ([(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> [Value])
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> Array
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))
-> Value)
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)) -> Value
delegAndRwdToJson ([(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> Value)
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> Value
forall a b. (a -> b) -> a -> b
$ DelegationsAndRewards
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
mergeDelegsAndRewards DelegationsAndRewards
delegsAndRwds
where
delegAndRwdToJson :: (StakeAddress, Maybe Lovelace, Maybe PoolId) -> Aeson.Value
delegAndRwdToJson :: (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)) -> Value
delegAndRwdToJson (StakeAddress
addr, Maybe Lovelace
mRewards, Maybe (Hash StakePoolKey)
mPoolId) =
[Pair] -> Value
Aeson.object
[ Key
"address" Key -> StakeAddress -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StakeAddress
addr
, Key
"delegation" Key -> Maybe (Hash StakePoolKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Hash StakePoolKey)
mPoolId
, Key
"rewardAccountBalance" Key -> Maybe Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
mRewards
]
instance FromJSON DelegationsAndRewards where
parseJSON :: Value -> Parser DelegationsAndRewards
parseJSON = String
-> (Array -> Parser DelegationsAndRewards)
-> Value
-> Parser DelegationsAndRewards
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"DelegationsAndRewards" ((Array -> Parser DelegationsAndRewards)
-> Value -> Parser DelegationsAndRewards)
-> (Array -> Parser DelegationsAndRewards)
-> Value
-> Parser DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
let vals :: [Value]
vals = Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
arr
[(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
decoded <- (Value
-> Parser
(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)))
-> [Value]
-> Parser
[(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value
-> Parser (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))
decodeObject [Value]
vals
DelegationsAndRewards -> Parser DelegationsAndRewards
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DelegationsAndRewards -> Parser DelegationsAndRewards)
-> DelegationsAndRewards -> Parser DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$ [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> DelegationsAndRewards
zipper [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
decoded
where
zipper :: [(StakeAddress, Maybe Lovelace, Maybe PoolId)]
-> DelegationsAndRewards
zipper :: [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> DelegationsAndRewards
zipper [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
l = do
let maps :: [(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))]
maps = [ ( Map StakeAddress Lovelace
-> (Lovelace -> Map StakeAddress Lovelace)
-> Maybe Lovelace
-> Map StakeAddress Lovelace
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map StakeAddress Lovelace
forall a. Monoid a => a
mempty (StakeAddress -> Lovelace -> Map StakeAddress Lovelace
forall k a. k -> a -> Map k a
Map.singleton StakeAddress
sa) Maybe Lovelace
delegAmt
, Map StakeAddress (Hash StakePoolKey)
-> (Hash StakePoolKey -> Map StakeAddress (Hash StakePoolKey))
-> Maybe (Hash StakePoolKey)
-> Map StakeAddress (Hash StakePoolKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map StakeAddress (Hash StakePoolKey)
forall a. Monoid a => a
mempty (StakeAddress
-> Hash StakePoolKey -> Map StakeAddress (Hash StakePoolKey)
forall k a. k -> a -> Map k a
Map.singleton StakeAddress
sa) Maybe (Hash StakePoolKey)
mPool
)
| (StakeAddress
sa, Maybe Lovelace
delegAmt, Maybe (Hash StakePoolKey)
mPool) <- [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
l
]
(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> DelegationsAndRewards
DelegationsAndRewards
((Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> DelegationsAndRewards)
-> (Map StakeAddress Lovelace,
Map StakeAddress (Hash StakePoolKey))
-> DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$ ((Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> (Map StakeAddress Lovelace,
Map StakeAddress (Hash StakePoolKey))
-> (Map StakeAddress Lovelace,
Map StakeAddress (Hash StakePoolKey)))
-> (Map StakeAddress Lovelace,
Map StakeAddress (Hash StakePoolKey))
-> [(Map StakeAddress Lovelace,
Map StakeAddress (Hash StakePoolKey))]
-> (Map StakeAddress Lovelace,
Map StakeAddress (Hash StakePoolKey))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
(\(Map StakeAddress Lovelace
amtA, Map StakeAddress (Hash StakePoolKey)
delegA) (Map StakeAddress Lovelace
amtB, Map StakeAddress (Hash StakePoolKey)
delegB) -> (Map StakeAddress Lovelace
amtA Map StakeAddress Lovelace
-> Map StakeAddress Lovelace -> Map StakeAddress Lovelace
forall a. Semigroup a => a -> a -> a
<> Map StakeAddress Lovelace
amtB, Map StakeAddress (Hash StakePoolKey)
delegA Map StakeAddress (Hash StakePoolKey)
-> Map StakeAddress (Hash StakePoolKey)
-> Map StakeAddress (Hash StakePoolKey)
forall a. Semigroup a => a -> a -> a
<> Map StakeAddress (Hash StakePoolKey)
delegB))
(Map StakeAddress Lovelace
forall a. Monoid a => a
mempty, Map StakeAddress (Hash StakePoolKey)
forall a. Monoid a => a
mempty)
[(Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))]
maps
decodeObject :: Aeson.Value
-> Aeson.Parser (StakeAddress, Maybe Lovelace, Maybe PoolId)
decodeObject :: Value
-> Parser (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))
decodeObject = String
-> (Object
-> Parser
(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)))
-> Value
-> Parser (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DelegationsAndRewards" ((Object
-> Parser
(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)))
-> Value
-> Parser
(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)))
-> (Object
-> Parser
(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)))
-> Value
-> Parser (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
StakeAddress
address <- Object
o Object -> Key -> Parser StakeAddress
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
Maybe (Hash StakePoolKey)
delegation <- Object
o Object -> Key -> Parser (Maybe (Hash StakePoolKey))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delegation"
Maybe Lovelace
rewardAccountBalance <- Object
o Object -> Key -> Parser (Maybe Lovelace)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rewardAccountBalance"
(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))
-> Parser (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeAddress
address, Maybe Lovelace
rewardAccountBalance, Maybe (Hash StakePoolKey)
delegation)
runQueryLeadershipSchedule
:: AnyConsensusModeParams
-> NetworkId
-> GenesisFile
-> VerificationKeyOrHashOrFile StakePoolKey
-> SigningKeyFile
-> EpochLeadershipSchedule
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLeadershipSchedule :: AnyConsensusModeParams
-> NetworkId
-> GenesisFile
-> VerificationKeyOrHashOrFile StakePoolKey
-> SigningKeyFile
-> EpochLeadershipSchedule
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLeadershipSchedule (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network
(GenesisFile String
genFile) VerificationKeyOrHashOrFile StakePoolKey
coldVerKeyFile (SigningKeyFile String
vrfSkeyFp)
EpochLeadershipSchedule
whichSchedule Maybe OutputFile
mJsonOutputFile = do
SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) era.
Monad m =>
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError m (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
Hash StakePoolKey
poolid <- (FileError InputDecodeError -> ShelleyQueryCmdError)
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT ShelleyQueryCmdError IO (Hash StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyQueryCmdError
ShelleyQueryCmdTextReadError
(ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT ShelleyQueryCmdError IO (Hash StakePoolKey))
-> (IO (Either (FileError InputDecodeError) (Hash StakePoolKey))
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey))
-> IO (Either (FileError InputDecodeError) (Hash StakePoolKey))
-> ExceptT ShelleyQueryCmdError IO (Hash StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError InputDecodeError) (Hash StakePoolKey))
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError InputDecodeError) (Hash StakePoolKey))
-> ExceptT ShelleyQueryCmdError IO (Hash StakePoolKey))
-> IO (Either (FileError InputDecodeError) (Hash StakePoolKey))
-> ExceptT ShelleyQueryCmdError IO (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$ AsType StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
-> IO (Either (FileError InputDecodeError) (Hash StakePoolKey))
forall keyrole.
(Key keyrole, SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole
-> IO (Either (FileError InputDecodeError) (Hash keyrole))
readVerificationKeyOrHashOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrHashOrFile StakePoolKey
coldVerKeyFile
SigningKey VrfKey
vrkSkey <- (FileError TextEnvelopeError -> ShelleyQueryCmdError)
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
-> ExceptT ShelleyQueryCmdError IO (SigningKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyQueryCmdError
ShelleyQueryCmdTextEnvelopeReadError (ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
-> ExceptT ShelleyQueryCmdError IO (SigningKey VrfKey))
-> (IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey))
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT ShelleyQueryCmdError IO (SigningKey VrfKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
(IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT ShelleyQueryCmdError IO (SigningKey VrfKey))
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT ShelleyQueryCmdError IO (SigningKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType (SigningKey VrfKey)
-> String
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType VrfKey -> AsType (SigningKey VrfKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VrfKey
AsVrfKey) String
vrfSkeyFp
ShelleyGenesis StandardShelley
shelleyGenesis <- (ShelleyGenesisCmdError -> ShelleyQueryCmdError)
-> ExceptT
ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
-> ExceptT ShelleyQueryCmdError IO (ShelleyGenesis StandardShelley)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyGenesisCmdError -> ShelleyQueryCmdError
ShelleyQueryCmdGenesisReadError (ExceptT ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
-> ExceptT
ShelleyQueryCmdError IO (ShelleyGenesis StandardShelley))
-> ExceptT
ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
-> ExceptT ShelleyQueryCmdError IO (ShelleyGenesis StandardShelley)
forall a b. (a -> b) -> a -> b
$
IO (Either ShelleyGenesisCmdError (ShelleyGenesis StandardShelley))
-> ExceptT
ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
(Either ShelleyGenesisCmdError (ShelleyGenesis StandardShelley))
-> ExceptT
ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley))
-> IO
(Either ShelleyGenesisCmdError (ShelleyGenesis StandardShelley))
-> ExceptT
ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
forall a b. (a -> b) -> a -> b
$ String
-> IO
(Either ShelleyGenesisCmdError (ShelleyGenesis StandardShelley))
readAndDecodeShelleyGenesis String
genFile
case ConsensusMode mode
cMode of
ConsensusMode mode
CardanoMode -> do
EraInMode era mode
eInMode <- CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode
Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE)
let pparamsQuery :: QueryInMode mode (Either EraMismatch ProtocolParameters)
pparamsQuery = EraInMode era mode
-> QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era ProtocolParameters
-> QueryInEra era ProtocolParameters
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era ProtocolParameters
forall era. QueryInShelleyBasedEra era ProtocolParameters
QueryProtocolParameters
ptclStateQuery :: QueryInMode mode (Either EraMismatch (ProtocolState era))
ptclStateQuery = EraInMode era mode
-> QueryInEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (ProtocolState era)
-> QueryInMode
CardanoMode (Either EraMismatch (ProtocolState era)))
-> (QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era))
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode CardanoMode (Either EraMismatch (ProtocolState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era)))
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (ProtocolState era)
forall era. QueryInShelleyBasedEra era (ProtocolState era)
QueryProtocolState
eraHistoryQuery :: QueryInMode CardanoMode (EraHistory CardanoMode)
eraHistoryQuery = ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode (EraHistory CardanoMode)
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
QueryEraHistory ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra
ProtocolParameters
pparams <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT ShelleyQueryCmdError IO ProtocolParameters
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch ProtocolParameters)
pparamsQuery
ProtocolState era
ptclState <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
-> ExceptT ShelleyQueryCmdError IO (ProtocolState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch (ProtocolState era))
ptclStateQuery
EraHistory CardanoMode
eraHistory <- (AcquireFailure -> ShelleyQueryCmdError)
-> ExceptT AcquireFailure IO (EraHistory CardanoMode)
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdError
ShelleyQueryCmdAcquireFailure (ExceptT AcquireFailure IO (EraHistory CardanoMode)
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode))
-> (IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT AcquireFailure IO (EraHistory CardanoMode))
-> IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT AcquireFailure IO (EraHistory CardanoMode)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode))
-> IO (Either AcquireFailure (EraHistory CardanoMode))
-> ExceptT ShelleyQueryCmdError IO (EraHistory CardanoMode)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode (EraHistory CardanoMode)
-> IO (Either AcquireFailure (EraHistory CardanoMode))
forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquireFailure result)
queryNodeLocalState LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing QueryInMode mode (EraHistory CardanoMode)
QueryInMode CardanoMode (EraHistory CardanoMode)
eraHistoryQuery
let eInfo :: EpochInfo (Either Text)
eInfo = EraHistory CardanoMode -> EpochInfo (Either Text)
toEpochInfo EraHistory CardanoMode
eraHistory
Set SlotNo
schedule :: Set SlotNo
<- case EpochLeadershipSchedule
whichSchedule of
EpochLeadershipSchedule
CurrentEpoch -> do
let currentEpochStateQuery :: QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
currentEpochStateQuery = EraInMode era mode
-> QueryInEra era (SerialisedCurrentEpochState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (SerialisedCurrentEpochState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era)))
-> QueryInEra era (SerialisedCurrentEpochState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
-> QueryInEra era (SerialisedCurrentEpochState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
forall era.
QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
QueryCurrentEpochState
currentEpochQuery :: QueryInMode mode (Either EraMismatch EpochNo)
currentEpochQuery = EraInMode era mode
-> QueryInEra era EpochNo
-> QueryInMode mode (Either EraMismatch EpochNo)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era EpochNo
-> QueryInMode mode (Either EraMismatch EpochNo))
-> QueryInEra era EpochNo
-> QueryInMode mode (Either EraMismatch EpochNo)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era EpochNo -> QueryInEra era EpochNo
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era EpochNo
forall era. QueryInShelleyBasedEra era EpochNo
QueryEpoch
SerialisedCurrentEpochState era
serCurrentEpochState <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
-> ExceptT
ShelleyQueryCmdError IO (SerialisedCurrentEpochState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
currentEpochStateQuery
EpochNo
curentEpoch <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch EpochNo)
-> ExceptT ShelleyQueryCmdError IO EpochNo
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch EpochNo)
currentEpochQuery
(LeadershipError -> ShelleyQueryCmdError)
-> ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT ShelleyQueryCmdError IO (Set SlotNo)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT LeadershipError -> ShelleyQueryCmdError
ShelleyQueryCmdLeaderShipError (ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT ShelleyQueryCmdError IO (Set SlotNo))
-> ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT ShelleyQueryCmdError IO (Set SlotNo)
forall a b. (a -> b) -> a -> b
$ Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither
(Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> ((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((ShelleyLedgerEra era ~ ledgerera,
Crypto ledgerera ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)), Era ledgerera,
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto ledgerera)) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
a)
-> a
eligibleLeaderSlotsConstaints ShelleyBasedEra era
sbe
(((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo))
-> ((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> ShelleyGenesis StandardShelley
-> EpochInfo (Either Text)
-> ProtocolParameters
-> ProtocolState era
-> Hash StakePoolKey
-> SigningKey VrfKey
-> SerialisedCurrentEpochState era
-> EpochNo
-> Either LeadershipError (Set SlotNo)
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera, Era ledgerera,
PraosProtocolSupportsNode (ConsensusProtocol era),
HasField "_d" (PParams ledgerera) UnitInterval,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking (Crypto (ShelleyLedgerEra era))),
FromCBOR (ChainDepState (ConsensusProtocol era))) =>
ShelleyBasedEra era
-> ShelleyGenesis StandardShelley
-> EpochInfo (Either Text)
-> ProtocolParameters
-> ProtocolState era
-> Hash StakePoolKey
-> SigningKey VrfKey
-> SerialisedCurrentEpochState era
-> EpochNo
-> Either LeadershipError (Set SlotNo)
currentEpochEligibleLeadershipSlots
ShelleyBasedEra era
sbe
ShelleyGenesis StandardShelley
shelleyGenesis
EpochInfo (Either Text)
eInfo
ProtocolParameters
pparams
ProtocolState era
ptclState
Hash StakePoolKey
poolid
SigningKey VrfKey
vrkSkey
SerialisedCurrentEpochState era
serCurrentEpochState
EpochNo
curentEpoch
EpochLeadershipSchedule
NextEpoch -> do
let currentEpochStateQuery :: QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
currentEpochStateQuery = EraInMode era mode
-> QueryInEra era (SerialisedCurrentEpochState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (SerialisedCurrentEpochState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era)))
-> QueryInEra era (SerialisedCurrentEpochState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
-> QueryInEra era (SerialisedCurrentEpochState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
forall era.
QueryInShelleyBasedEra era (SerialisedCurrentEpochState era)
QueryCurrentEpochState
currentEpochQuery :: QueryInMode mode (Either EraMismatch EpochNo)
currentEpochQuery = EraInMode era mode
-> QueryInEra era EpochNo
-> QueryInMode mode (Either EraMismatch EpochNo)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era EpochNo
-> QueryInMode mode (Either EraMismatch EpochNo))
-> QueryInEra era EpochNo
-> QueryInMode mode (Either EraMismatch EpochNo)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era EpochNo -> QueryInEra era EpochNo
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era EpochNo
forall era. QueryInShelleyBasedEra era EpochNo
QueryEpoch
ChainTip
tip <- IO ChainTip -> ExceptT ShelleyQueryCmdError IO ChainTip
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainTip -> ExceptT ShelleyQueryCmdError IO ChainTip)
-> IO ChainTip -> ExceptT ShelleyQueryCmdError IO ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode -> IO ChainTip
forall mode. LocalNodeConnectInfo mode -> IO ChainTip
getLocalChainTip LocalNodeConnectInfo mode
localNodeConnInfo
EpochNo
curentEpoch <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch EpochNo)
-> ExceptT ShelleyQueryCmdError IO EpochNo
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch EpochNo)
currentEpochQuery
SerialisedCurrentEpochState era
serCurrentEpochState <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
-> ExceptT
ShelleyQueryCmdError IO (SerialisedCurrentEpochState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode
mode (Either EraMismatch (SerialisedCurrentEpochState era))
currentEpochStateQuery
(LeadershipError -> ShelleyQueryCmdError)
-> ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT ShelleyQueryCmdError IO (Set SlotNo)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT LeadershipError -> ShelleyQueryCmdError
ShelleyQueryCmdLeaderShipError (ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT ShelleyQueryCmdError IO (Set SlotNo))
-> ExceptT LeadershipError IO (Set SlotNo)
-> ExceptT ShelleyQueryCmdError IO (Set SlotNo)
forall a b. (a -> b) -> a -> b
$ Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither
(Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
-> ExceptT LeadershipError IO (Set SlotNo)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> ((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((ShelleyLedgerEra era ~ ledgerera,
Crypto ledgerera ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)), Era ledgerera,
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto ledgerera)) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
a)
-> a
eligibleLeaderSlotsConstaints ShelleyBasedEra era
sbe
(((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo))
-> ((ShelleyLedgerEra era ~ ShelleyLedgerEra era,
Crypto (ShelleyLedgerEra era) ~ StandardCrypto,
PraosProtocolSupportsNode (ConsensusProtocol era),
FromCBOR (ChainDepState (ConsensusProtocol era)),
Era (ShelleyLedgerEra era),
HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Signable (VRF (Crypto (ShelleyLedgerEra era))) Seed,
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking StandardCrypto),
ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
~ Blake2b_224) =>
Either LeadershipError (Set SlotNo))
-> Either LeadershipError (Set SlotNo)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> ShelleyGenesis StandardShelley
-> SerialisedCurrentEpochState era
-> ProtocolState era
-> Hash StakePoolKey
-> SigningKey VrfKey
-> ProtocolParameters
-> EpochInfo (Either Text)
-> (ChainTip, EpochNo)
-> Either LeadershipError (Set SlotNo)
forall era.
(HasField "_d" (PParams (ShelleyLedgerEra era)) UnitInterval,
Era (ShelleyLedgerEra era),
Share (TxOut (ShelleyLedgerEra era))
~ Interns (Credential 'Staking (Crypto (ShelleyLedgerEra era))),
FromCBOR (ChainDepState (ConsensusProtocol era)),
PraosProtocolSupportsNode (ConsensusProtocol era)) =>
ShelleyBasedEra era
-> ShelleyGenesis StandardShelley
-> SerialisedCurrentEpochState era
-> ProtocolState era
-> Hash StakePoolKey
-> SigningKey VrfKey
-> ProtocolParameters
-> EpochInfo (Either Text)
-> (ChainTip, EpochNo)
-> Either LeadershipError (Set SlotNo)
nextEpochEligibleLeadershipSlots ShelleyBasedEra era
sbe ShelleyGenesis StandardShelley
shelleyGenesis
SerialisedCurrentEpochState era
serCurrentEpochState ProtocolState era
ptclState Hash StakePoolKey
poolid SigningKey VrfKey
vrkSkey ProtocolParameters
pparams
EpochInfo (Either Text)
eInfo (ChainTip
tip, EpochNo
curentEpoch)
case Maybe OutputFile
mJsonOutputFile of
Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> IO ()
printLeadershipScheduleAsText Set SlotNo
schedule EpochInfo (Either Text)
eInfo (UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis StandardShelley -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
sgSystemStart ShelleyGenesis StandardShelley
shelleyGenesis)
Just (OutputFile String
jsonOutputFile) ->
IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
jsonOutputFile (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> ByteString
printLeadershipScheduleAsJson Set SlotNo
schedule EpochInfo (Either Text)
eInfo (UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis StandardShelley -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
sgSystemStart ShelleyGenesis StandardShelley
shelleyGenesis)
ConsensusMode mode
mode -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> (AnyConsensusMode -> ShelleyQueryCmdError)
-> AnyConsensusMode
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AnyConsensusMode -> ShelleyQueryCmdError
ShelleyQueryCmdUnsupportedMode (AnyConsensusMode -> ExceptT ShelleyQueryCmdError IO ())
-> AnyConsensusMode -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode
where
printLeadershipScheduleAsText
:: Set SlotNo
-> EpochInfo (Either Text)
-> SystemStart
-> IO ()
printLeadershipScheduleAsText :: Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> IO ()
printLeadershipScheduleAsText Set SlotNo
leadershipSlots EpochInfo (Either Text)
eInfo SystemStart
sStart = do
Text -> IO ()
Text.putStrLn Text
title
String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
'-'
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SlotNo -> EpochInfo (Either Text) -> SystemStart -> String
showLeadershipSlot SlotNo
slot EpochInfo (Either Text)
eInfo SystemStart
sStart
| SlotNo
slot <- Set SlotNo -> [SlotNo]
forall a. Set a -> [a]
Set.toList Set SlotNo
leadershipSlots ]
where
title :: Text
title :: Text
title =
Text
" SlotNo UTC Time "
showLeadershipSlot
:: SlotNo
-> EpochInfo (Either Text)
-> SystemStart
-> String
showLeadershipSlot :: SlotNo -> EpochInfo (Either Text) -> SystemStart -> String
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 ->
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
" "
, Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
sn
, String
" "
, UTCTime -> String
forall a b. (Show a, ConvertText String b) => a -> b
show UTCTime
slotTime
]
Left Text
err ->
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
" "
, Word64 -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
sn
, String
" "
, Text -> String
Text.unpack Text
err
]
printLeadershipScheduleAsJson
:: Set SlotNo
-> EpochInfo (Either Text)
-> SystemStart
-> LBS.ByteString
printLeadershipScheduleAsJson :: Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> ByteString
printLeadershipScheduleAsJson Set SlotNo
leadershipSlots EpochInfo (Either Text)
eInfo SystemStart
sStart =
[Value] -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ 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]
sort (Set SlotNo -> [SlotNo]
forall a. Set a -> [a]
Set.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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Word64
sn
, Key
"slotTime" Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= UTCTime
slotTime
]
Left Text
err ->
[Pair] -> Value
Aeson.object
[ Key
"slotNumber" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Word64
sn
, Key
"error" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Text -> String
Text.unpack Text
err
]
calcEraInMode
:: CardanoEra era
-> ConsensusMode mode
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
calcEraInMode :: CardanoEra era
-> ConsensusMode mode
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
calcEraInMode CardanoEra era
era ConsensusMode mode
mode=
ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode) (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era))
(Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
mode
determineEra
:: ConsensusModeParams