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

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

import           Cardano.Api hiding (QueryInShelleyBasedEra (..))
import qualified Cardano.Api as Api
import qualified Cardano.Api.Consensus as Consensus
import           Cardano.Api.Ledger (StandardCrypto, strictMaybeToMaybe)
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Network (Serialised (..))
import qualified Cardano.Api.Network as Consensus
import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))

import qualified Cardano.CLI.EraBased.Commands.Query as Cmd
import           Cardano.CLI.EraBased.Run.Genesis.Common
import           Cardano.CLI.Helpers
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.NodeEraMismatchError
import           Cardano.CLI.Types.Errors.QueryCmdError
import           Cardano.CLI.Types.Key
import           Cardano.CLI.Types.Output (QueryDRepStateOutput (..))
import qualified Cardano.CLI.Types.Output as O
import           Cardano.Crypto.Hash (hashToBytesAsHex)
import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
import           Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCTime, hoistEpochInfo)
import           Cardano.Slotting.Time (RelativeTime (..), toRelativeTime)

import           Control.Monad (forM, forM_, join)
import           Data.Aeson as Aeson
import qualified Data.Aeson as A
import           Data.Aeson.Encode.Pretty (encodePretty)
import           Data.Bifunctor (Bifunctor (..))
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.Coerce (coerce)
import           Data.Function ((&))
import           Data.Functor ((<&>))
import qualified Data.List as List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Proxy (Proxy (..))
import qualified Data.Sequence as Seq
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.String
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy.IO as LT
import           Data.Time.Clock
import           GHC.Exts (IsList (..))
import           GHC.Generics
import           Lens.Micro ((^.))
import           Numeric (showEFloat)
import           Prettyprinter
import           Prettyprinter.Render.Terminal (AnsiStyle)
import qualified System.IO as IO
import           Text.Printf (printf)

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

runQueryProtocolParametersCmd
  :: ()
  => Cmd.QueryProtocolParametersCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryProtocolParametersCmd :: QueryProtocolParametersCmdArgs -> ExceptT QueryCmdError IO ()
runQueryProtocolParametersCmd
  Cmd.QueryProtocolParametersCmdArgs
    { SocketPath
nodeSocketPath :: SocketPath
nodeSocketPath :: QueryProtocolParametersCmdArgs -> SocketPath
Cmd.nodeSocketPath
    , ConsensusModeParams
consensusModeParams :: ConsensusModeParams
consensusModeParams :: QueryProtocolParametersCmdArgs -> ConsensusModeParams
Cmd.consensusModeParams
    , NetworkId
networkId :: NetworkId
networkId :: QueryProtocolParametersCmdArgs -> NetworkId
Cmd.networkId
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryProtocolParametersCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath
    AnyCardanoEra CardanoEra era
era <- (AcquiringFailure -> QueryCmdError)
-> ExceptT AcquiringFailure IO AnyCardanoEra
-> ExceptT QueryCmdError IO AnyCardanoEra
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure (ExceptT AcquiringFailure IO AnyCardanoEra
 -> ExceptT QueryCmdError IO AnyCardanoEra)
-> ExceptT AcquiringFailure IO AnyCardanoEra
-> ExceptT QueryCmdError IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo -> ExceptT AcquiringFailure IO AnyCardanoEra
determineEra LocalNodeConnectInfo
localNodeConnInfo
    ShelleyBasedEra era
sbe <- forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> a -> (eon era -> a) -> a
forEraInEon @ShelleyBasedEra CardanoEra era
era (QueryCmdError -> ExceptT QueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra) ShelleyBasedEra era
-> ExceptT QueryCmdError IO (ShelleyBasedEra era)
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    let qInMode :: QueryInMode (Either EraMismatch (PParams (ShelleyLedgerEra era)))
qInMode = QueryInEra era (PParams (ShelleyLedgerEra era))
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall era result1.
QueryInEra era result1 -> QueryInMode (Either EraMismatch result1)
QueryInEra (QueryInEra era (PParams (ShelleyLedgerEra era))
 -> QueryInMode
      (Either EraMismatch (PParams (ShelleyLedgerEra era))))
-> QueryInEra era (PParams (ShelleyLedgerEra era))
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
-> QueryInEra era (PParams (ShelleyLedgerEra era))
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
forall era.
QueryInShelleyBasedEra era (PParams (ShelleyLedgerEra era))
Api.QueryProtocolParameters
    PParams (ShelleyLedgerEra era)
pp <-
      LocalNodeConnectInfo
-> QueryInMode
     (Either EraMismatch (PParams (ShelleyLedgerEra era)))
-> ExceptT
     QueryConvenienceError IO (PParams (ShelleyLedgerEra era))
forall result.
LocalNodeConnectInfo
-> QueryInMode (Either EraMismatch result)
-> ExceptT QueryConvenienceError IO result
executeQueryAnyMode LocalNodeConnectInfo
localNodeConnInfo QueryInMode (Either EraMismatch (PParams (ShelleyLedgerEra era)))
qInMode
        ExceptT QueryConvenienceError IO (PParams (ShelleyLedgerEra era))
-> (ExceptT
      QueryConvenienceError IO (PParams (ShelleyLedgerEra era))
    -> ExceptT QueryCmdError IO (PParams (ShelleyLedgerEra era)))
-> ExceptT QueryCmdError IO (PParams (ShelleyLedgerEra era))
forall a b. a -> (a -> b) -> b
& (QueryConvenienceError -> QueryCmdError)
-> ExceptT
     QueryConvenienceError IO (PParams (ShelleyLedgerEra era))
-> ExceptT QueryCmdError IO (PParams (ShelleyLedgerEra era))
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError QueryConvenienceError -> QueryCmdError
QueryCmdConvenienceError
    ShelleyBasedEra era
-> Maybe (File () 'Out)
-> PParams (ShelleyLedgerEra era)
-> ExceptT QueryCmdError IO ()
forall era.
ShelleyBasedEra era
-> Maybe (File () 'Out)
-> PParams (ShelleyLedgerEra era)
-> ExceptT QueryCmdError IO ()
writeProtocolParameters ShelleyBasedEra era
sbe Maybe (File () 'Out)
mOutFile PParams (ShelleyLedgerEra era)
pp
   where
    writeProtocolParameters
      :: ShelleyBasedEra era
      -> Maybe (File () Out)
      -> L.PParams (ShelleyLedgerEra era)
      -> ExceptT QueryCmdError IO ()
    writeProtocolParameters :: forall era.
ShelleyBasedEra era
-> Maybe (File () 'Out)
-> PParams (ShelleyLedgerEra era)
-> ExceptT QueryCmdError IO ()
writeProtocolParameters ShelleyBasedEra era
sbe Maybe (File () 'Out)
mOutFile' PParams (ShelleyLedgerEra era)
pparams =
      (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
        Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile' (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
          ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => ByteString) -> ByteString)
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$
            PParams (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty PParams (ShelleyLedgerEra era)
pparams

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

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

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

runQueryTipCmd
  :: ()
  => Cmd.QueryTipCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryTipCmd :: QueryTipCmdArgs -> ExceptT QueryCmdError IO ()
runQueryTipCmd
  ( Cmd.QueryTipCmdArgs
      { commons :: QueryTipCmdArgs -> QueryCommons
Cmd.commons =
        Cmd.QueryCommons
          { SocketPath
nodeSocketPath :: SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
Cmd.nodeSocketPath
          , ConsensusModeParams
consensusModeParams :: ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
Cmd.consensusModeParams
          , NetworkId
networkId :: NetworkId
networkId :: QueryCommons -> NetworkId
Cmd.networkId
          , Target ChainPoint
target :: Target ChainPoint
target :: QueryCommons -> Target ChainPoint
Cmd.target
          }
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryTipCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
      }
    ) = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    Either AcquiringFailure (QueryTipLocalState Any)
eLocalState <- IO
  (Either
     QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
-> ExceptT
     QueryCmdError IO (Either AcquiringFailure (QueryTipLocalState Any))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO
   (Either
      QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
 -> ExceptT
      QueryCmdError
      IO
      (Either AcquiringFailure (QueryTipLocalState Any)))
-> IO
     (Either
        QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
-> ExceptT
     QueryCmdError IO (Either AcquiringFailure (QueryTipLocalState Any))
forall a b. (a -> b) -> a -> b
$
      (Either
   AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any))
 -> Either
      QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
-> IO
     (Either
        QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either
  AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any))
-> Either
     QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Either AcquiringFailure (m a) -> m (Either AcquiringFailure a)
sequence (IO
   (Either
      AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
 -> IO
      (Either
         QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any))))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
-> IO
     (Either
        QueryCmdError (Either AcquiringFailure (QueryTipLocalState Any)))
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState Any))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (QueryTipLocalState Any))
 -> IO
      (Either
         AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState Any))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError (QueryTipLocalState Any)))
forall a b. (a -> b) -> a -> b
$
          ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (QueryTipLocalState Any)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState Any))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (QueryTipLocalState Any)
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (QueryTipLocalState Any)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (QueryTipLocalState Any)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (QueryTipLocalState Any))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra
era <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError AnyCardanoEra)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError AnyCardanoEra)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError AnyCardanoEra)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      AnyCardanoEra)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     AnyCardanoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)
            EraHistory
eraHistory <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError EraHistory)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError EraHistory)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError EraHistory)
queryEraHistory ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError EraHistory)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError EraHistory)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError EraHistory)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      EraHistory)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     EraHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)
            Maybe (WithOrigin BlockNo)
mChainBlockNo <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
queryChainBlockNo ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (WithOrigin BlockNo))
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion) ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (WithOrigin BlockNo)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (WithOrigin BlockNo)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (Maybe (WithOrigin BlockNo)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (WithOrigin BlockNo))
forall a b. a -> (a -> b) -> b
& (WithOrigin BlockNo -> Maybe (WithOrigin BlockNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (WithOrigin BlockNo)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (WithOrigin BlockNo))
forall a b.
(a -> b)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithOrigin BlockNo -> Maybe (WithOrigin BlockNo)
forall a. a -> Maybe a
Just
            Maybe ChainPoint
mChainPoint <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError ChainPoint)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError ChainPoint)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError ChainPoint)
queryChainPoint ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError ChainPoint)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError ChainPoint)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ChainPoint)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion) ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  ChainPoint
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      ChainPoint
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (Maybe ChainPoint))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe ChainPoint)
forall a b. a -> (a -> b) -> b
& (ChainPoint -> Maybe ChainPoint)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     ChainPoint
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe ChainPoint)
forall a b.
(a -> b)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChainPoint -> Maybe ChainPoint
forall a. a -> Maybe a
Just
            Maybe SystemStart
mSystemStart <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError SystemStart)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError SystemStart)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError SystemStart)
querySystemStart ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Either UnsupportedNtcVersionError SystemStart)
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Either UnsupportedNtcVersionError SystemStart)
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Either UnsupportedNtcVersionError SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      SystemStart)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion) ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  SystemStart
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      SystemStart
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (Maybe SystemStart))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe SystemStart)
forall a b. a -> (a -> b) -> b
& (SystemStart -> Maybe SystemStart)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SystemStart
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe SystemStart)
forall a b.
(a -> b)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SystemStart -> Maybe SystemStart
forall a. a -> Maybe a
Just

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

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

    ChainTip
chainTip <-
      Maybe ChainTip -> ExceptT QueryCmdError IO (Maybe ChainTip)
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (QueryTipLocalState Any)
mLocalState Maybe (QueryTipLocalState Any)
-> (QueryTipLocalState Any -> Maybe ChainTip) -> Maybe ChainTip
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryTipLocalState Any -> Maybe ChainTip
forall mode. QueryTipLocalState mode -> Maybe ChainTip
O.mChainTip)
        -- The chain tip is unavailable via local state query because we are connecting with an older
        -- node to client protocol so we use chain sync instead which necessitates another connection.
        -- At some point when we can stop supporting the older node to client protocols, this fallback
        -- can be removed.
        ExceptT QueryCmdError IO (Maybe ChainTip)
-> (ExceptT QueryCmdError IO (Maybe ChainTip)
    -> ExceptT QueryCmdError IO ChainTip)
-> ExceptT QueryCmdError IO ChainTip
forall a b. a -> (a -> b) -> b
& ExceptT QueryCmdError IO ChainTip
-> ExceptT QueryCmdError IO (Maybe ChainTip)
-> ExceptT QueryCmdError IO ChainTip
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (LocalNodeConnectInfo -> ExceptT QueryCmdError IO ChainTip
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo -> m ChainTip
queryChainTipViaChainSync LocalNodeConnectInfo
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 QueryCmdError IO QueryTipLocalStateOutput)
-> ExceptT QueryCmdError 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 QueryCmdError IO QueryTipLocalStateOutput)
 -> ExceptT QueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> (QueryTipLocalState Any
    -> ExceptT QueryCmdError IO QueryTipLocalStateOutput)
-> ExceptT QueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall a b. (a -> b) -> a -> b
$ \QueryTipLocalState Any
localState -> do
      case SlotNo
-> EraHistory
-> Either
     PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
slotToEpoch SlotNo
tipSlotNo (QueryTipLocalState Any -> EraHistory
forall mode. QueryTipLocalState mode -> EraHistory
O.eraHistory QueryTipLocalState Any
localState) of
        Left PastHorizonException
e -> do
          IO () -> ExceptT QueryCmdError IO ()
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT QueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
LT.hPutStrLn Handle
IO.stderr (Text -> ExceptT QueryCmdError IO ())
-> Text -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle -> Text
docToLazyText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$
              Doc AnsiStyle
"Warning: Epoch unavailable: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> QueryCmdError -> Doc AnsiStyle
forall ann. QueryCmdError -> Doc ann
renderQueryCmdError (PastHorizonException -> QueryCmdError
QueryCmdPastHorizon PastHorizonException
e)
          QueryTipLocalStateOutput
-> ExceptT QueryCmdError IO QueryTipLocalStateOutput
forall a. a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryTipLocalStateOutput
 -> ExceptT QueryCmdError IO QueryTipLocalStateOutput)
-> QueryTipLocalStateOutput
-> ExceptT QueryCmdError IO QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$
            O.QueryTipLocalStateOutput
              { localStateChainTip :: ChainTip
O.localStateChainTip = ChainTip
chainTip
              , mEra :: Maybe AnyCardanoEra
O.mEra = Maybe AnyCardanoEra
forall a. Maybe a
Nothing
              , mEpoch :: Maybe EpochNo
O.mEpoch = Maybe EpochNo
forall a. Maybe a
Nothing
              , mSyncProgress :: Maybe Text
O.mSyncProgress = Maybe Text
forall a. Maybe a
Nothing
              , mSlotInEpoch :: Maybe Word64
O.mSlotInEpoch = Maybe Word64
forall a. Maybe a
Nothing
              , mSlotsToEpochEnd :: Maybe Word64
O.mSlotsToEpochEnd = Maybe Word64
forall a. Maybe a
Nothing
              }
        Right (EpochNo
epochNo, SlotsInEpoch Word64
slotsInEpoch, SlotsToEpochEnd Word64
slotsToEpochEnd) -> do
          Either QueryCmdError Text
syncProgressResult <- ExceptT QueryCmdError (ExceptT QueryCmdError IO) Text
-> ExceptT QueryCmdError IO (Either QueryCmdError Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QueryCmdError (ExceptT QueryCmdError IO) Text
 -> ExceptT QueryCmdError IO (Either QueryCmdError Text))
-> ExceptT QueryCmdError (ExceptT QueryCmdError IO) Text
-> ExceptT QueryCmdError IO (Either QueryCmdError Text)
forall a b. (a -> b) -> a -> b
$ do
            UTCTime
systemStart <-
              (SystemStart -> UTCTime) -> Maybe SystemStart -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SystemStart -> UTCTime
getSystemStart (QueryTipLocalState Any -> Maybe SystemStart
forall mode. QueryTipLocalState mode -> Maybe SystemStart
O.mSystemStart QueryTipLocalState Any
localState) Maybe UTCTime
-> (Maybe UTCTime
    -> ExceptT QueryCmdError (ExceptT QueryCmdError IO) UTCTime)
-> ExceptT QueryCmdError (ExceptT QueryCmdError IO) UTCTime
forall a b. a -> (a -> b) -> b
& QueryCmdError
-> Maybe UTCTime
-> ExceptT QueryCmdError (ExceptT QueryCmdError IO) UTCTime
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe QueryCmdError
QueryCmdSystemStartUnavailable
            RelativeTime
nowSeconds <- SystemStart -> UTCTime -> RelativeTime
toRelativeTime (UTCTime -> SystemStart
SystemStart UTCTime
systemStart) (UTCTime -> RelativeTime)
-> ExceptT QueryCmdError (ExceptT QueryCmdError IO) UTCTime
-> ExceptT QueryCmdError (ExceptT QueryCmdError IO) RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
-> ExceptT QueryCmdError (ExceptT QueryCmdError IO) UTCTime
forall a.
IO a -> ExceptT QueryCmdError (ExceptT QueryCmdError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            RelativeTime
tipTimeResult <-
              SlotNo
-> EraHistory
-> Either PastHorizonException (RelativeTime, SlotLength)
getProgress SlotNo
tipSlotNo (QueryTipLocalState Any -> EraHistory
forall mode. QueryTipLocalState mode -> EraHistory
O.eraHistory QueryTipLocalState Any
localState) Either PastHorizonException (RelativeTime, SlotLength)
-> (Either PastHorizonException (RelativeTime, SlotLength)
    -> Either QueryCmdError RelativeTime)
-> Either QueryCmdError RelativeTime
forall a b. a -> (a -> b) -> b
& (PastHorizonException -> QueryCmdError)
-> ((RelativeTime, SlotLength) -> RelativeTime)
-> Either PastHorizonException (RelativeTime, SlotLength)
-> Either QueryCmdError RelativeTime
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap PastHorizonException -> QueryCmdError
QueryCmdPastHorizon (RelativeTime, SlotLength) -> RelativeTime
forall a b. (a, b) -> a
fst Either QueryCmdError RelativeTime
-> (Either QueryCmdError RelativeTime
    -> ExceptT QueryCmdError (ExceptT QueryCmdError IO) RelativeTime)
-> ExceptT QueryCmdError (ExceptT QueryCmdError IO) RelativeTime
forall a b. a -> (a -> b) -> b
& Either QueryCmdError RelativeTime
-> ExceptT QueryCmdError (ExceptT QueryCmdError 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 QueryCmdError (ExceptT QueryCmdError IO) Text
forall a. a -> ExceptT QueryCmdError (ExceptT QueryCmdError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExceptT QueryCmdError (ExceptT QueryCmdError IO) Text)
-> Text -> ExceptT QueryCmdError (ExceptT QueryCmdError IO) Text
forall a b. (a -> b) -> a -> b
$ RelativeTime -> RelativeTime -> RelativeTime -> Text
percentage RelativeTime
tolerance RelativeTime
tipTimeResult RelativeTime
nowSeconds

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

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

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

-- | Query the UTxO, filtered by a given set of addresses, from a Shelley node
-- via the local state query protocol.
runQueryUTxOCmd
  :: ()
  => Cmd.QueryUTxOCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryUTxOCmd :: QueryUTxOCmdArgs -> ExceptT QueryCmdError IO ()
runQueryUTxOCmd
  ( Cmd.QueryUTxOCmdArgs
      { commons :: QueryUTxOCmdArgs -> QueryCommons
Cmd.commons =
        Cmd.QueryCommons
          { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
          , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
          , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
          , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
          }
      , QueryUTxOFilter
queryFilter :: QueryUTxOFilter
queryFilter :: QueryUTxOCmdArgs -> QueryUTxOFilter
Cmd.queryFilter
      , Maybe OutputFormatJsonOrText
format :: Maybe OutputFormatJsonOrText
format :: QueryUTxOCmdArgs -> Maybe OutputFormatJsonOrText
Cmd.format
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryUTxOCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
      }
    ) = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

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

            ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ do
              ShelleyBasedEra era
-> Maybe OutputFormatJsonOrText
-> Maybe (File () 'Out)
-> UTxO era
-> ExceptT QueryCmdError IO ()
forall era.
ShelleyBasedEra era
-> Maybe OutputFormatJsonOrText
-> Maybe (File () 'Out)
-> UTxO era
-> ExceptT QueryCmdError IO ()
writeFilteredUTxOs ShelleyBasedEra era
sbe Maybe OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile UTxO era
utxo
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

runQueryKesPeriodInfoCmd
  :: ()
  => Cmd.QueryKesPeriodInfoCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryKesPeriodInfoCmd :: QueryKesPeriodInfoCmdArgs -> ExceptT QueryCmdError IO ()
runQueryKesPeriodInfoCmd
  Cmd.QueryKesPeriodInfoCmdArgs
    { commons :: QueryKesPeriodInfoCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , File () 'In
nodeOpCertFp :: File () 'In
nodeOpCertFp :: QueryKesPeriodInfoCmdArgs -> File () 'In
Cmd.nodeOpCertFp
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryKesPeriodInfoCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    OperationalCertificate
opCert <-
      IO (Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT
     QueryCmdError
     IO
     (Either (FileError TextEnvelopeError) OperationalCertificate)
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AsType OperationalCertificate
-> File () 'In
-> IO (Either (FileError TextEnvelopeError) OperationalCertificate)
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType OperationalCertificate
AsOperationalCertificate File () 'In
nodeOpCertFp)
        ExceptT
  QueryCmdError
  IO
  (Either (FileError TextEnvelopeError) OperationalCertificate)
-> (ExceptT
      QueryCmdError
      IO
      (Either (FileError TextEnvelopeError) OperationalCertificate)
    -> ExceptT QueryCmdError IO OperationalCertificate)
-> ExceptT QueryCmdError IO OperationalCertificate
forall a b. a -> (a -> b) -> b
& (FileError TextEnvelopeError
 -> ExceptT QueryCmdError IO OperationalCertificate)
-> ExceptT
     QueryCmdError
     IO
     (Either (FileError TextEnvelopeError) OperationalCertificate)
-> ExceptT QueryCmdError IO OperationalCertificate
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError IO OperationalCertificate
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO OperationalCertificate)
-> (FileError TextEnvelopeError -> QueryCmdError)
-> FileError TextEnvelopeError
-> ExceptT QueryCmdError IO OperationalCertificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> QueryCmdError
QueryCmdOpCertCounterReadError)

    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

            -- We check that the KES period specified in the operational certificate is correct
            -- based on the KES period defined in the genesis parameters and the current slot number
            GenesisParameters ShelleyEra
gParams <- LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either
     UnsupportedNtcVersionError
     (Either EraMismatch (GenesisParameters ShelleyEra)))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (GenesisParameters ShelleyEra)
forall (m :: * -> *) a.
Monad m =>
m (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError m a
easyRunQuery (ShelleyBasedEra era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GenesisParameters ShelleyEra)))
forall era block point r.
ShelleyBasedEra era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GenesisParameters ShelleyEra)))
queryGenesisParameters ShelleyBasedEra era
sbe)

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

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

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

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

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

              (OpCertOnDiskCounter
onDiskC, Maybe OpCertNodeStateCounter
stateC) <- ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ExceptT
      QueryCmdError
      IO
      (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ExceptT
    QueryCmdError
    IO
    (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
 -> ExceptT
      QueryCmdError
      IO
      (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> (ShelleyBasedEraConstraints era =>
    ExceptT
      QueryCmdError
      IO
      (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter))
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a b. (a -> b) -> a -> b
$ ProtocolState era
-> OperationalCertificate
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall era.
(PraosProtocolSupportsNode (ConsensusProtocol era),
 FromCBOR (ChainDepState (ConsensusProtocol era)),
 ADDRHASH (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era))
 ~ Blake2b_224) =>
ProtocolState era
-> OperationalCertificate
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
opCertOnDiskAndStateCounters ProtocolState era
ptclState OperationalCertificate
opCert

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

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

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

              IO () -> ExceptT QueryCmdError IO ()
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT QueryCmdError IO ())
-> IO () -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn ByteString
kesPeriodInfoJSON
              Maybe (File () 'Out)
-> (File () 'Out -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
                Maybe (File () 'Out)
mOutFile
                ( \(File String
oFp) ->
                    (IOException -> QueryCmdError)
-> IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> QueryCmdError
QueryCmdWriteFileError (FileError () -> QueryCmdError)
-> (IOException -> FileError ()) -> IOException -> QueryCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
oFp) (IO () -> ExceptT QueryCmdError IO ())
-> IO () -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
                      String -> ByteString -> IO ()
LBS.writeFile String
oFp ByteString
kesPeriodInfoJSON
                )
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left
   where
    currentKesPeriod :: ChainTip -> GenesisParameters era -> CurrentKesPeriod
    currentKesPeriod :: forall era. ChainTip -> GenesisParameters era -> CurrentKesPeriod
currentKesPeriod ChainTip
ChainTipAtGenesis GenesisParameters era
_ = Word64 -> CurrentKesPeriod
CurrentKesPeriod Word64
0
    currentKesPeriod (ChainTip SlotNo
currSlot Hash BlockHeader
_ BlockNo
_) GenesisParameters era
gParams =
      let slotsPerKesPeriod :: Word64
slotsPerKesPeriod = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ GenesisParameters era -> Int
forall era. GenesisParameters era -> Int
protocolParamSlotsPerKESPeriod GenesisParameters era
gParams
       in Word64 -> CurrentKesPeriod
CurrentKesPeriod (Word64 -> CurrentKesPeriod) -> Word64 -> CurrentKesPeriod
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
currSlot Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
slotsPerKesPeriod

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

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

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

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

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

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

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

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

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

      -- We need the stake pool id to determine what the counter of our SPO
      -- should be.
      let opCertCounterMap :: Map
  (KeyHash
     'BlockIssuer
     (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
forall (proxy :: * -> *).
proxy (ConsensusProtocol era)
-> ChainDepState (ConsensusProtocol era)
-> Map
     (KeyHash
        'BlockIssuer
        (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)))
     Word64
Consensus.getOpCertCounters (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ConsensusProtocol era)) ChainDepState (ConsensusProtocol era)
chainDepState
          StakePoolKeyHash KeyHash 'StakePool StandardCrypto
blockIssuerHash = VerificationKey StakePoolKey -> PoolId
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))
forall a b. Coercible a b => a -> b
coerce KeyHash 'StakePool StandardCrypto
blockIssuerHash) Map
  (KeyHash
     'BlockIssuer
     (PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)))
  Word64
opCertCounterMap of
        -- Operational certificate exists in the protocol state
        -- so our ondisk op cert counter must be greater than or
        -- equal to what is in the node state.
        Just Word64
ptclStateCounter -> (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a. a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> OpCertOnDiskCounter
OpCertOnDiskCounter Word64
onDiskOpCertCount, OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter
forall a. a -> Maybe a
Just (OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter)
-> OpCertNodeStateCounter -> Maybe OpCertNodeStateCounter
forall a b. (a -> b) -> a -> b
$ Word64 -> OpCertNodeStateCounter
OpCertNodeStateCounter Word64
ptclStateCounter)
        Maybe Word64
Nothing -> (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
-> ExceptT
     QueryCmdError
     IO
     (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter)
forall a. a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> OpCertOnDiskCounter
OpCertOnDiskCounter Word64
onDiskOpCertCount, Maybe OpCertNodeStateCounter
forall a. Maybe a
Nothing)

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

-- | Query the current and future parameters for a stake pool, including the retirement date.
-- Any of these may be empty (in which case a null will be displayed).
runQueryPoolStateCmd
  :: ()
  => Cmd.QueryPoolStateCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryPoolStateCmd :: QueryPoolStateCmdArgs -> ExceptT QueryCmdError IO ()
runQueryPoolStateCmd
  Cmd.QueryPoolStateCmdArgs
    { commons :: QueryPoolStateCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , AllOrOnly PoolId
allOrOnlyPoolIds :: AllOrOnly PoolId
allOrOnlyPoolIds :: QueryPoolStateCmdArgs -> AllOrOnly PoolId
Cmd.allOrOnlyPoolIds
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryPoolStateCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

            BabbageEraOnwards era
beo <- CardanoEra BabbageEra
-> CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (BabbageEraOnwards era)
forall (eon :: * -> *) era minEra (m :: * -> *).
(Eon eon, Monad m) =>
CardanoEra minEra
-> CardanoEra era -> ExceptT QueryCmdError m (eon era)
requireEon CardanoEra BabbageEra
BabbageEra CardanoEra era
era

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

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

            ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    SerialisedPoolState era -> ExceptT QueryCmdError IO ())
-> SerialisedPoolState era
-> ExceptT QueryCmdError IO ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe (Maybe (File () 'Out)
-> SerialisedPoolState era -> ExceptT QueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 EraCrypto ledgerera ~ StandardCrypto, Era ledgerera) =>
Maybe (File () 'Out)
-> SerialisedPoolState era -> ExceptT QueryCmdError IO ()
writePoolState Maybe (File () 'Out)
mOutFile) SerialisedPoolState era
result
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

-- | Query the local mempool state
runQueryTxMempoolCmd
  :: ()
  => Cmd.QueryTxMempoolCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryTxMempoolCmd :: QueryTxMempoolCmdArgs -> ExceptT QueryCmdError IO ()
runQueryTxMempoolCmd
  Cmd.QueryTxMempoolCmdArgs
    { SocketPath
nodeSocketPath :: SocketPath
nodeSocketPath :: QueryTxMempoolCmdArgs -> SocketPath
Cmd.nodeSocketPath
    , ConsensusModeParams
consensusModeParams :: ConsensusModeParams
consensusModeParams :: QueryTxMempoolCmdArgs -> ConsensusModeParams
Cmd.consensusModeParams
    , NetworkId
networkId :: NetworkId
networkId :: QueryTxMempoolCmdArgs -> NetworkId
Cmd.networkId
    , TxMempoolQuery
query :: TxMempoolQuery
query :: QueryTxMempoolCmdArgs -> TxMempoolQuery
Cmd.query
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryTxMempoolCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    LocalTxMonitoringQuery
localQuery <- case TxMempoolQuery
query of
      TxMempoolQueryTxExists TxId
tx -> do
        AnyCardanoEra CardanoEra era
era <-
          LocalNodeConnectInfo -> ExceptT AcquiringFailure IO AnyCardanoEra
determineEra LocalNodeConnectInfo
localNodeConnInfo
            ExceptT AcquiringFailure IO AnyCardanoEra
-> (ExceptT AcquiringFailure IO AnyCardanoEra
    -> ExceptT QueryCmdError IO AnyCardanoEra)
-> ExceptT QueryCmdError IO AnyCardanoEra
forall a b. a -> (a -> b) -> b
& (AcquiringFailure -> QueryCmdError)
-> ExceptT AcquiringFailure IO AnyCardanoEra
-> ExceptT QueryCmdError IO AnyCardanoEra
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure
        LocalTxMonitoringQuery
-> ExceptT QueryCmdError IO LocalTxMonitoringQuery
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalTxMonitoringQuery
 -> ExceptT QueryCmdError IO LocalTxMonitoringQuery)
-> LocalTxMonitoringQuery
-> ExceptT QueryCmdError IO LocalTxMonitoringQuery
forall a b. (a -> b) -> a -> b
$ TxIdInMode -> LocalTxMonitoringQuery
LocalTxMonitoringQueryTx (TxIdInMode -> LocalTxMonitoringQuery)
-> TxIdInMode -> LocalTxMonitoringQuery
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> TxId -> TxIdInMode
forall era. CardanoEra era -> TxId -> TxIdInMode
TxIdInMode CardanoEra era
era TxId
tx
      TxMempoolQuery
TxMempoolQueryNextTx -> LocalTxMonitoringQuery
-> ExceptT QueryCmdError IO LocalTxMonitoringQuery
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTxMonitoringQuery
LocalTxMonitoringSendNextTx
      TxMempoolQuery
TxMempoolQueryInfo -> LocalTxMonitoringQuery
-> ExceptT QueryCmdError IO LocalTxMonitoringQuery
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTxMonitoringQuery
LocalTxMonitoringMempoolInformation

    LocalTxMonitoringResult
result <- IO LocalTxMonitoringResult
-> ExceptT QueryCmdError IO LocalTxMonitoringResult
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LocalTxMonitoringResult
 -> ExceptT QueryCmdError IO LocalTxMonitoringResult)
-> IO LocalTxMonitoringResult
-> ExceptT QueryCmdError IO LocalTxMonitoringResult
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> LocalTxMonitoringQuery -> IO LocalTxMonitoringResult
forall (m :: * -> *).
MonadIO m =>
LocalNodeConnectInfo
-> LocalTxMonitoringQuery -> m LocalTxMonitoringResult
queryTxMonitoringLocal LocalNodeConnectInfo
localNodeConnInfo LocalTxMonitoringQuery
localQuery
    (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        LocalTxMonitoringResult -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty LocalTxMonitoringResult
result

runQuerySlotNumberCmd
  :: ()
  => Cmd.QuerySlotNumberCmdArgs
  -> ExceptT QueryCmdError IO ()
runQuerySlotNumberCmd :: QuerySlotNumberCmdArgs -> ExceptT QueryCmdError IO ()
runQuerySlotNumberCmd
  Cmd.QuerySlotNumberCmdArgs
    { commons :: QuerySlotNumberCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , UTCTime
utcTime :: UTCTime
utcTime :: QuerySlotNumberCmdArgs -> UTCTime
Cmd.utcTime
    } = do
    SlotNo Word64
slotNo <- SocketPath
-> ConsensusModeParams
-> NetworkId
-> Target ChainPoint
-> UTCTime
-> ExceptT QueryCmdError IO SlotNo
utcTimeToSlotNo SocketPath
nodeSocketPath ConsensusModeParams
consensusModeParams NetworkId
networkId Target ChainPoint
target UTCTime
utcTime
    IO () -> ExceptT QueryCmdError IO ()
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT QueryCmdError IO ())
-> (String -> IO ()) -> String -> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStr (String -> ExceptT QueryCmdError IO ())
-> String -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> String
forall a. Show a => a -> String
show Word64
slotNo

runQueryRefScriptSizeCmd
  :: ()
  => Cmd.QueryRefScriptSizeCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryRefScriptSizeCmd :: QueryRefScriptSizeCmdArgs -> ExceptT QueryCmdError IO ()
runQueryRefScriptSizeCmd
  Cmd.QueryRefScriptSizeCmdArgs
    { commons :: QueryRefScriptSizeCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Set TxIn
transactionInputs :: Set TxIn
transactionInputs :: QueryRefScriptSizeCmdArgs -> Set TxIn
Cmd.transactionInputs
    , Maybe OutputFormatJsonOrText
format :: Maybe OutputFormatJsonOrText
format :: QueryRefScriptSizeCmdArgs -> Maybe OutputFormatJsonOrText
Cmd.format
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryRefScriptSizeCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

            BabbageEraOnwards era
beo <- CardanoEra BabbageEra
-> CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (BabbageEraOnwards era)
forall (eon :: * -> *) era minEra (m :: * -> *).
(Eon eon, Monad m) =>
CardanoEra minEra
-> CardanoEra era -> ExceptT QueryCmdError m (eon era)
requireEon CardanoEra BabbageEra
BabbageEra CardanoEra era
era

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

            ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$
              Maybe OutputFormatJsonOrText
-> Maybe (File () 'Out)
-> RefInputScriptSize
-> ExceptT QueryCmdError IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadIOTransError QueryCmdError t m, ToJSON a, Pretty a) =>
Maybe OutputFormatJsonOrText -> Maybe (File b 'Out) -> a -> t m ()
writeFormattedOutput Maybe OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile (RefInputScriptSize -> ExceptT QueryCmdError IO ())
-> RefInputScriptSize -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
                Int -> RefInputScriptSize
RefInputScriptSize (Int -> RefInputScriptSize) -> Int -> RefInputScriptSize
forall a b. (a -> b) -> a -> b
$
                  BabbageEraOnwards era
-> UTxO (ShelleyLedgerEra era) -> Set TxIn -> Int
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera) =>
BabbageEraOnwards era -> UTxO ledgerera -> Set TxIn -> Int
getReferenceInputsSizeForTxIds BabbageEraOnwards era
beo (ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era -> UTxO era -> UTxO (ShelleyLedgerEra era)
toLedgerUTxO ShelleyBasedEra era
sbe UTxO era
utxo) Set TxIn
transactionInputs
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

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

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

-- | Obtain stake snapshot information for a pool, plus information about the total active stake.
-- This information can be used for leader slot calculation, for example, and has been requested by SPOs.
-- Obtaining the information directly is significantly more time and memory efficient than using a full ledger state dump.
runQueryStakeSnapshotCmd
  :: ()
  => Cmd.QueryStakeSnapshotCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryStakeSnapshotCmd :: QueryStakeSnapshotCmdArgs -> ExceptT QueryCmdError IO ()
runQueryStakeSnapshotCmd
  Cmd.QueryStakeSnapshotCmdArgs
    { commons :: QueryStakeSnapshotCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , AllOrOnly PoolId
allOrOnlyPoolIds :: AllOrOnly PoolId
allOrOnlyPoolIds :: QueryStakeSnapshotCmdArgs -> AllOrOnly PoolId
Cmd.allOrOnlyPoolIds
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryStakeSnapshotCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

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

            BabbageEraOnwards era
beo <- CardanoEra BabbageEra
-> CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (BabbageEraOnwards era)
forall (eon :: * -> *) era minEra (m :: * -> *).
(Eon eon, Monad m) =>
CardanoEra minEra
-> CardanoEra era -> ExceptT QueryCmdError m (eon era)
requireEon CardanoEra BabbageEra
BabbageEra CardanoEra era
era

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

            ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    SerialisedStakeSnapshots era -> ExceptT QueryCmdError IO ())
-> SerialisedStakeSnapshots era
-> ExceptT QueryCmdError IO ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe (Maybe (File () 'Out)
-> SerialisedStakeSnapshots era -> ExceptT QueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 EraCrypto ledgerera ~ StandardCrypto) =>
Maybe (File () 'Out)
-> SerialisedStakeSnapshots era -> ExceptT QueryCmdError IO ()
writeStakeSnapshots Maybe (File () 'Out)
mOutFile) SerialisedStakeSnapshots era
result
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

runQueryLedgerStateCmd
  :: ()
  => Cmd.QueryLedgerStateCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryLedgerStateCmd :: QueryLedgerStateCmdArgs -> ExceptT QueryCmdError IO ()
runQueryLedgerStateCmd
  ( Cmd.QueryLedgerStateCmdArgs
      { commons :: QueryLedgerStateCmdArgs -> QueryCommons
Cmd.commons =
        Cmd.QueryCommons
          { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
          , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
          , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
          , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
          }
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryLedgerStateCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
      }
    ) = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

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

            ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    SerialisedDebugLedgerState era -> ExceptT QueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT QueryCmdError IO ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe (Maybe (File () 'Out)
-> SerialisedDebugLedgerState era -> ExceptT QueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era)) =>
Maybe (File () 'Out)
-> SerialisedDebugLedgerState era -> ExceptT QueryCmdError IO ()
writeLedgerState Maybe (File () 'Out)
mOutFile) SerialisedDebugLedgerState era
result
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

runQueryProtocolStateCmd
  :: ()
  => Cmd.QueryProtocolStateCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryProtocolStateCmd :: QueryProtocolStateCmdArgs -> ExceptT QueryCmdError IO ()
runQueryProtocolStateCmd
  ( Cmd.QueryProtocolStateCmdArgs
      { commons :: QueryProtocolStateCmdArgs -> QueryCommons
Cmd.commons =
        Cmd.QueryCommons
          { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
          , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
          , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
          , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
          }
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryProtocolStateCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
      }
    ) = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

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

            ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ShelleyBasedEraConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> Maybe (File () 'Out)
-> ProtocolState era
-> ExceptT QueryCmdError IO ()
forall era.
ShelleyBasedEra era
-> Maybe (File () 'Out)
-> ProtocolState era
-> ExceptT QueryCmdError IO ()
writeProtocolState ShelleyBasedEra era
sbe Maybe (File () 'Out)
mOutFile ProtocolState era
result
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

-- | Query the current delegations and reward accounts, filtered by a given
-- set of addresses, from a Shelley node via the local state query protocol.
runQueryStakeAddressInfoCmd
  :: ()
  => Cmd.QueryStakeAddressInfoCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryStakeAddressInfoCmd :: QueryStakeAddressInfoCmdArgs -> ExceptT QueryCmdError IO ()
runQueryStakeAddressInfoCmd
  cmd :: QueryStakeAddressInfoCmdArgs
cmd@Cmd.QueryStakeAddressInfoCmdArgs
    { commons :: QueryStakeAddressInfoCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryStakeAddressInfoCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath
    AnyCardanoEra CardanoEra era
era <-
      (AcquiringFailure -> QueryCmdError)
-> ExceptT
     AcquiringFailure
     IO
     (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT
     QueryCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT
        AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure
        (IO
  (Either
     AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
-> ExceptT
     AcquiringFailure
     IO
     (Either UnsupportedNtcVersionError AnyCardanoEra)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
 -> ExceptT
      AcquiringFailure
      IO
      (Either UnsupportedNtcVersionError AnyCardanoEra))
-> IO
     (Either
        AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
-> ExceptT
     AcquiringFailure
     IO
     (Either UnsupportedNtcVersionError AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError AnyCardanoEra)
-> IO
     (Either
        AcquiringFailure (Either UnsupportedNtcVersionError AnyCardanoEra))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target LocalStateQueryExpr
  BlockInMode
  ChainPoint
  QueryInMode
  ()
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
forall block point r.
LocalStateQueryExpr
  block
  point
  QueryInMode
  r
  IO
  (Either UnsupportedNtcVersionError AnyCardanoEra)
queryCurrentEra)
        ExceptT
  QueryCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
-> (ExceptT
      QueryCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
    -> ExceptT QueryCmdError IO AnyCardanoEra)
-> ExceptT QueryCmdError IO AnyCardanoEra
forall a b. a -> (a -> b) -> b
& (UnsupportedNtcVersionError
 -> ExceptT QueryCmdError IO AnyCardanoEra)
-> ExceptT
     QueryCmdError IO (Either UnsupportedNtcVersionError AnyCardanoEra)
-> ExceptT QueryCmdError IO AnyCardanoEra
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError IO AnyCardanoEra
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO AnyCardanoEra)
-> (UnsupportedNtcVersionError -> QueryCmdError)
-> UnsupportedNtcVersionError
-> ExceptT QueryCmdError IO AnyCardanoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsupportedNtcVersionError -> QueryCmdError
QueryCmdUnsupportedNtcVersion)
    ShelleyBasedEra era
sbe <- CardanoEra era
-> ExceptT QueryCmdError IO (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era ExceptT QueryCmdError IO (Maybe (ShelleyBasedEra era))
-> (ExceptT QueryCmdError IO (Maybe (ShelleyBasedEra era))
    -> ExceptT QueryCmdError IO (ShelleyBasedEra era))
-> ExceptT QueryCmdError IO (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT QueryCmdError IO (ShelleyBasedEra era)
-> ExceptT QueryCmdError IO (Maybe (ShelleyBasedEra era))
-> ExceptT QueryCmdError IO (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError -> ExceptT QueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

    StakeAddressInfoData
said <- QueryStakeAddressInfoCmdArgs
-> ExceptT QueryCmdError IO StakeAddressInfoData
callQueryStakeAddressInfoCmd QueryStakeAddressInfoCmdArgs
cmd

    ShelleyBasedEra era
-> StakeAddressInfoData
-> Maybe (File () 'Out)
-> ExceptT QueryCmdError IO ()
forall era.
ShelleyBasedEra era
-> StakeAddressInfoData
-> Maybe (File () 'Out)
-> ExceptT QueryCmdError IO ()
writeStakeAddressInfo ShelleyBasedEra era
sbe StakeAddressInfoData
said Maybe (File () 'Out)
mOutFile

-- | Container for data returned by 'callQueryStakeAddressInfoCmd'
data StakeAddressInfoData = StakeAddressInfoData
  { StakeAddressInfoData -> DelegationsAndRewards
rewards :: DelegationsAndRewards
  , StakeAddressInfoData -> Map StakeAddress Lovelace
deposits :: Map StakeAddress Lovelace
  , StakeAddressInfoData -> Map StakeAddress (DRep StandardCrypto)
delegatees :: Map StakeAddress (L.DRep L.StandardCrypto)
  }

callQueryStakeAddressInfoCmd
  :: ()
  => Cmd.QueryStakeAddressInfoCmdArgs
  -> ExceptT QueryCmdError IO StakeAddressInfoData
callQueryStakeAddressInfoCmd :: QueryStakeAddressInfoCmdArgs
-> ExceptT QueryCmdError IO StakeAddressInfoData
callQueryStakeAddressInfoCmd
  Cmd.QueryStakeAddressInfoCmdArgs
    { commons :: QueryStakeAddressInfoCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , addr :: QueryStakeAddressInfoCmdArgs -> StakeAddress
Cmd.addr = StakeAddress Network
_ StakeCredential StandardCrypto
addr
    } =
    do
      let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

      IO
  (Either
     AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO
   (Either
      AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
 -> ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure (Either QueryCmdError StakeAddressInfoData)))
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError StakeAddressInfoData)
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError StakeAddressInfoData)
 -> IO
      (Either
         AcquiringFailure (Either QueryCmdError StakeAddressInfoData)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError StakeAddressInfoData)
-> IO
     (Either
        AcquiringFailure (Either QueryCmdError StakeAddressInfoData))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  StakeAddressInfoData
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError StakeAddressInfoData)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   StakeAddressInfoData
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError StakeAddressInfoData))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     StakeAddressInfoData
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError StakeAddressInfoData)
forall a b. (a -> b) -> a -> b
$ do
        AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

        ShelleyBasedEra era
sbe <-
          CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
            ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

        let stakeAddr :: Set StakeCredential
stakeAddr = StakeCredential -> Set StakeCredential
forall a. a -> Set a
Set.singleton (StakeCredential -> Set StakeCredential)
-> StakeCredential -> Set StakeCredential
forall a b. (a -> b) -> a -> b
$ StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential StakeCredential StandardCrypto
addr

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

        BabbageEraOnwards era
beo <- CardanoEra BabbageEra
-> CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (BabbageEraOnwards era)
forall (eon :: * -> *) era minEra (m :: * -> *).
(Eon eon, Monad m) =>
CardanoEra minEra
-> CardanoEra era -> ExceptT QueryCmdError m (eon era)
requireEon CardanoEra BabbageEra
BabbageEra CardanoEra era
era

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

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

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

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

writeStakeAddressInfo
  :: ShelleyBasedEra era
  -> StakeAddressInfoData
  -> Maybe (File () Out)
  -> ExceptT QueryCmdError IO ()
writeStakeAddressInfo :: forall era.
ShelleyBasedEra era
-> StakeAddressInfoData
-> Maybe (File () 'Out)
-> ExceptT QueryCmdError IO ()
writeStakeAddressInfo
  ShelleyBasedEra era
sbe
  ( StakeAddressInfoData
      { rewards :: StakeAddressInfoData -> DelegationsAndRewards
rewards = DelegationsAndRewards (Map StakeAddress Lovelace
stakeAccountBalances, Map StakeAddress PoolId
stakePools)
      , deposits :: StakeAddressInfoData -> Map StakeAddress Lovelace
deposits = Map StakeAddress Lovelace
stakeDelegDeposits
      , delegatees :: StakeAddressInfoData -> Map StakeAddress (DRep StandardCrypto)
delegatees = Map StakeAddress (DRep StandardCrypto)
voteDelegatees
      }
    )
  Maybe (File () 'Out)
mOutFile =
    (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ([Value] -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> [Value]
forall era. ShelleyBasedEra era -> [Value]
jsonInfo ShelleyBasedEra era
sbe)
   where
    jsonInfo :: ShelleyBasedEra era -> [Aeson.Value]
    jsonInfo :: forall era. ShelleyBasedEra era -> [Value]
jsonInfo =
      (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> [Value])
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era -> [Value])
-> ShelleyBasedEra era
-> [Value]
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
        ( [Value] -> ShelleyToBabbageEra era -> [Value]
forall a b. a -> b -> a
const ([Value] -> ShelleyToBabbageEra era -> [Value])
-> [Value] -> ShelleyToBabbageEra era -> [Value]
forall a b. (a -> b) -> a -> b
$
            ((StakeAddress, Maybe Lovelace, Maybe PoolId,
  Maybe (DRep StandardCrypto), Maybe Lovelace)
 -> Value)
-> [(StakeAddress, Maybe Lovelace, Maybe PoolId,
     Maybe (DRep StandardCrypto), Maybe Lovelace)]
-> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \(StakeAddress
addr, Maybe Lovelace
mBalance, Maybe PoolId
mPoolId, Maybe (DRep StandardCrypto)
_mDRep, Maybe Lovelace
mDeposit) ->
                  [Pair] -> Value
Aeson.object
                    [ Key
"address" Key -> StakeAddress -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StakeAddress
addr
                    , Key
"delegation" Key -> Maybe PoolId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe PoolId
mPoolId
                    , Key
"rewardAccountBalance" Key -> Maybe Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
mBalance
                    , Key
"delegationDeposit" Key -> Maybe Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
mDeposit
                    ]
              )
              [(StakeAddress, Maybe Lovelace, Maybe PoolId,
  Maybe (DRep StandardCrypto), Maybe Lovelace)]
merged
        )
        ( [Value] -> ConwayEraOnwards era -> [Value]
forall a b. a -> b -> a
const ([Value] -> ConwayEraOnwards era -> [Value])
-> [Value] -> ConwayEraOnwards era -> [Value]
forall a b. (a -> b) -> a -> b
$
            ((StakeAddress, Maybe Lovelace, Maybe PoolId,
  Maybe (DRep StandardCrypto), Maybe Lovelace)
 -> Value)
-> [(StakeAddress, Maybe Lovelace, Maybe PoolId,
     Maybe (DRep StandardCrypto), Maybe Lovelace)]
-> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \(StakeAddress
addr, Maybe Lovelace
mBalance, Maybe PoolId
mPoolId, Maybe (DRep StandardCrypto)
mDRep, Maybe Lovelace
mDeposit) ->
                  [Pair] -> Value
Aeson.object
                    [ Key
"address" Key -> StakeAddress -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StakeAddress
addr
                    , Key
"stakeDelegation" Key -> Maybe PoolId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe PoolId
mPoolId
                    , Key
"voteDelegation" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (DRep StandardCrypto -> Text)
-> Maybe (DRep StandardCrypto) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DRep StandardCrypto -> Text
friendlyDRep Maybe (DRep StandardCrypto)
mDRep
                    , Key
"rewardAccountBalance" Key -> Maybe Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
mBalance
                    , Key
"delegationDeposit" Key -> Maybe Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
mDeposit
                    ]
              )
              [(StakeAddress, Maybe Lovelace, Maybe PoolId,
  Maybe (DRep StandardCrypto), Maybe Lovelace)]
merged
        )

    friendlyDRep :: L.DRep L.StandardCrypto -> Text
    friendlyDRep :: DRep StandardCrypto -> Text
friendlyDRep DRep StandardCrypto
L.DRepAlwaysAbstain = Text
"alwaysAbstain"
    friendlyDRep DRep StandardCrypto
L.DRepAlwaysNoConfidence = Text
"alwaysNoConfidence"
    friendlyDRep (L.DRepCredential Credential 'DRepRole StandardCrypto
cred) =
      Credential 'DRepRole StandardCrypto -> Text
forall (kr :: KeyRole) c. Credential kr c -> Text
L.credToText Credential 'DRepRole StandardCrypto
cred -- this will pring "keyHash-..." or "scriptHash-...", depending on the type of credential
    merged
      :: [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe (L.DRep L.StandardCrypto), Maybe Lovelace)]
    merged :: [(StakeAddress, Maybe Lovelace, Maybe PoolId,
  Maybe (DRep StandardCrypto), Maybe Lovelace)]
merged =
      [ (StakeAddress
addr, Maybe Lovelace
mBalance, Maybe PoolId
mPoolId, Maybe (DRep StandardCrypto)
mDRep, Maybe Lovelace
mDeposit)
      | StakeAddress
addr <-
          Set StakeAddress -> [Item (Set StakeAddress)]
forall l. IsList l => l -> [Item l]
toList
            ( [Set StakeAddress] -> Set StakeAddress
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                [ Map StakeAddress Lovelace -> Set StakeAddress
forall k a. Map k a -> Set k
Map.keysSet Map StakeAddress Lovelace
stakeAccountBalances
                , Map StakeAddress PoolId -> Set StakeAddress
forall k a. Map k a -> Set k
Map.keysSet Map StakeAddress PoolId
stakePools
                , Map StakeAddress Lovelace -> Set StakeAddress
forall k a. Map k a -> Set k
Map.keysSet Map StakeAddress Lovelace
stakeDelegDeposits
                , Map StakeAddress (DRep StandardCrypto) -> Set StakeAddress
forall k a. Map k a -> Set k
Map.keysSet Map StakeAddress (DRep StandardCrypto)
voteDelegatees
                ]
            )
      , let mBalance :: Maybe Lovelace
mBalance = StakeAddress -> Map StakeAddress Lovelace -> Maybe Lovelace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
addr Map StakeAddress Lovelace
stakeAccountBalances
            mPoolId :: Maybe PoolId
mPoolId = StakeAddress -> Map StakeAddress PoolId -> Maybe PoolId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
addr Map StakeAddress PoolId
stakePools
            mDeposit :: Maybe Lovelace
mDeposit = StakeAddress -> Map StakeAddress Lovelace -> Maybe Lovelace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
addr Map StakeAddress Lovelace
stakeDelegDeposits
            mDRep :: Maybe (DRep StandardCrypto)
mDRep = StakeAddress
-> Map StakeAddress (DRep StandardCrypto)
-> Maybe (DRep StandardCrypto)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
addr Map StakeAddress (DRep StandardCrypto)
voteDelegatees
      ]

writeLedgerState
  :: forall era ledgerera
   . ShelleyLedgerEra era ~ ledgerera
  => ToJSON (DebugLedgerState era)
  => FromCBOR (DebugLedgerState era)
  => Maybe (File () Out)
  -> SerialisedDebugLedgerState era
  -> ExceptT QueryCmdError IO ()
writeLedgerState :: forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era)) =>
Maybe (File () 'Out)
-> SerialisedDebugLedgerState era -> ExceptT QueryCmdError IO ()
writeLedgerState Maybe (File () 'Out)
mOutFile qState :: SerialisedDebugLedgerState era
qState@(SerialisedDebugLedgerState Serialised (NewEpochState (ShelleyLedgerEra era))
serLedgerState) =
  case Maybe (File () 'Out)
mOutFile of
    Maybe (File () 'Out)
Nothing ->
      case SerialisedDebugLedgerState era
-> Either (ByteString, DecoderError) (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either (ByteString, DecoderError) (DebugLedgerState era)
decodeDebugLedgerState SerialisedDebugLedgerState era
qState of
        Left (ByteString
bs, DecoderError
_decoderError) -> (HelpersError -> QueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> QueryCmdError
QueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT QueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
        Right DebugLedgerState era
ledgerState -> IO () -> ExceptT QueryCmdError IO ()
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT QueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT QueryCmdError IO ())
-> ByteString -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ DebugLedgerState era -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode DebugLedgerState era
ledgerState
    Just (File String
fpath) ->
      (IOException -> QueryCmdError)
-> IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> QueryCmdError
QueryCmdWriteFileError (FileError () -> QueryCmdError)
-> (IOException -> FileError ()) -> IOException -> QueryCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO () -> ExceptT QueryCmdError IO ())
-> IO () -> ExceptT QueryCmdError 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 {k} (a :: k). Serialised a -> ByteString
unSerialised Serialised (NewEpochState ledgerera)
Serialised (NewEpochState (ShelleyLedgerEra era))
serLedgerState

writeStakeSnapshots
  :: forall era ledgerera
   . ()
  => ShelleyLedgerEra era ~ ledgerera
  => L.EraCrypto ledgerera ~ StandardCrypto
  => Maybe (File () Out)
  -> SerialisedStakeSnapshots era
  -> ExceptT QueryCmdError IO ()
writeStakeSnapshots :: forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 EraCrypto ledgerera ~ StandardCrypto) =>
Maybe (File () 'Out)
-> SerialisedStakeSnapshots era -> ExceptT QueryCmdError IO ()
writeStakeSnapshots Maybe (File () 'Out)
mOutFile SerialisedStakeSnapshots era
qState = do
  StakeSnapshot StakeSnapshots (EraCrypto (ShelleyLedgerEra era))
snapshot <-
    Either DecoderError (StakeSnapshot era)
-> ExceptT
     QueryCmdError IO (Either DecoderError (StakeSnapshot era))
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SerialisedStakeSnapshots era
-> Either DecoderError (StakeSnapshot era)
forall era.
FromCBOR (StakeSnapshots (EraCrypto (ShelleyLedgerEra era))) =>
SerialisedStakeSnapshots era
-> Either DecoderError (StakeSnapshot era)
decodeStakeSnapshot SerialisedStakeSnapshots era
qState)
      ExceptT QueryCmdError IO (Either DecoderError (StakeSnapshot era))
-> (ExceptT
      QueryCmdError IO (Either DecoderError (StakeSnapshot era))
    -> ExceptT QueryCmdError IO (StakeSnapshot era))
-> ExceptT QueryCmdError IO (StakeSnapshot era)
forall a b. a -> (a -> b) -> b
& (DecoderError -> ExceptT QueryCmdError IO (StakeSnapshot era))
-> ExceptT
     QueryCmdError IO (Either DecoderError (StakeSnapshot era))
-> ExceptT QueryCmdError IO (StakeSnapshot era)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError IO (StakeSnapshot era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO (StakeSnapshot era))
-> (DecoderError -> QueryCmdError)
-> DecoderError
-> ExceptT QueryCmdError IO (StakeSnapshot era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> QueryCmdError
QueryCmdStakeSnapshotDecodeError)

  -- Calculate the three pool and active stake values for the given pool
  IO () -> ExceptT QueryCmdError IO ()
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT QueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> IO ())
-> (File () 'Out -> ByteString -> IO ())
-> Maybe (File () 'Out)
-> ByteString
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString -> IO ()
LBS.putStrLn (String -> ByteString -> IO ()
LBS.writeFile (String -> ByteString -> IO ())
-> (File () 'Out -> String) -> File () 'Out -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File () 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile) Maybe (File () 'Out)
mOutFile (ByteString -> ExceptT QueryCmdError IO ())
-> ByteString -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ StakeSnapshots StandardCrypto -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty StakeSnapshots (EraCrypto (ShelleyLedgerEra era))
StakeSnapshots StandardCrypto
snapshot

-- | This function obtains the pool parameters, equivalent to the following jq query on the output of query ledger-state
--   .nesEs.esLState.lsDPState.dpsPState.psStakePoolParams.<pool_id>
writePoolState
  :: forall era ledgerera
   . ()
  => ShelleyLedgerEra era ~ ledgerera
  => L.EraCrypto ledgerera ~ StandardCrypto
  => L.Era ledgerera
  => Maybe (File () Out)
  -> SerialisedPoolState era
  -> ExceptT QueryCmdError IO ()
writePoolState :: forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 EraCrypto ledgerera ~ StandardCrypto, Era ledgerera) =>
Maybe (File () 'Out)
-> SerialisedPoolState era -> ExceptT QueryCmdError IO ()
writePoolState Maybe (File () 'Out)
mOutFile SerialisedPoolState era
serialisedCurrentEpochState = do
  PoolState PState (ShelleyLedgerEra era)
poolState <-
    Either DecoderError (PoolState era)
-> ExceptT QueryCmdError IO (Either DecoderError (PoolState era))
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SerialisedPoolState era -> Either DecoderError (PoolState era)
forall era.
(Era (ShelleyLedgerEra era),
 DecCBOR (PState (ShelleyLedgerEra era))) =>
SerialisedPoolState era -> Either DecoderError (PoolState era)
decodePoolState SerialisedPoolState era
serialisedCurrentEpochState)
      ExceptT QueryCmdError IO (Either DecoderError (PoolState era))
-> (ExceptT QueryCmdError IO (Either DecoderError (PoolState era))
    -> ExceptT QueryCmdError IO (PoolState era))
-> ExceptT QueryCmdError IO (PoolState era)
forall a b. a -> (a -> b) -> b
& (DecoderError -> ExceptT QueryCmdError IO (PoolState era))
-> ExceptT QueryCmdError IO (Either DecoderError (PoolState era))
-> ExceptT QueryCmdError IO (PoolState era)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError IO (PoolState era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO (PoolState era))
-> (DecoderError -> QueryCmdError)
-> DecoderError
-> ExceptT QueryCmdError IO (PoolState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> QueryCmdError
QueryCmdPoolStateDecodeError)

  let hks :: [L.KeyHash L.StakePool StandardCrypto]
      hks :: [KeyHash 'StakePool StandardCrypto]
hks =
        Set (KeyHash 'StakePool StandardCrypto)
-> [Item (Set (KeyHash 'StakePool StandardCrypto))]
forall l. IsList l => l -> [Item l]
toList (Set (KeyHash 'StakePool StandardCrypto)
 -> [Item (Set (KeyHash 'StakePool StandardCrypto))])
-> Set (KeyHash 'StakePool StandardCrypto)
-> [Item (Set (KeyHash 'StakePool StandardCrypto))]
forall a b. (a -> b) -> a -> b
$
          Map (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Set (KeyHash 'StakePool StandardCrypto)
forall k a. Map k a -> Set k
Map.keysSet (PState ledgerera
-> Map
     (KeyHash 'StakePool (EraCrypto ledgerera))
     (PoolParams (EraCrypto ledgerera))
forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
L.psStakePoolParams PState ledgerera
PState (ShelleyLedgerEra era)
poolState)
            Set (KeyHash 'StakePool StandardCrypto)
-> Set (KeyHash 'StakePool StandardCrypto)
-> Set (KeyHash 'StakePool StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Set (KeyHash 'StakePool StandardCrypto)
forall k a. Map k a -> Set k
Map.keysSet (PState ledgerera
-> Map
     (KeyHash 'StakePool (EraCrypto ledgerera))
     (PoolParams (EraCrypto ledgerera))
forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
L.psFutureStakePoolParams PState ledgerera
PState (ShelleyLedgerEra era)
poolState)
            Set (KeyHash 'StakePool StandardCrypto)
-> Set (KeyHash 'StakePool StandardCrypto)
-> Set (KeyHash 'StakePool StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool StandardCrypto) EpochNo
-> Set (KeyHash 'StakePool StandardCrypto)
forall k a. Map k a -> Set k
Map.keysSet (PState ledgerera
-> Map (KeyHash 'StakePool (EraCrypto ledgerera)) EpochNo
forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
L.psRetiring PState ledgerera
PState (ShelleyLedgerEra era)
poolState)

  let poolStates :: Map (L.KeyHash 'L.StakePool StandardCrypto) (Params StandardCrypto)
      poolStates :: Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto)
poolStates =
        [Item
   (Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto))]
-> Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList ([Item
    (Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto))]
 -> Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto))
-> [Item
      (Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto))]
-> Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto)
forall a b. (a -> b) -> a -> b
$
          [KeyHash 'StakePool StandardCrypto]
hks
            [KeyHash 'StakePool StandardCrypto]
-> (KeyHash 'StakePool StandardCrypto
    -> (KeyHash 'StakePool StandardCrypto, Params StandardCrypto))
-> [(KeyHash 'StakePool StandardCrypto, Params StandardCrypto)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \KeyHash 'StakePool StandardCrypto
hk ->
                    ( KeyHash 'StakePool StandardCrypto
hk
                    , Params
                        { poolParameters :: Maybe (PoolParams StandardCrypto)
poolParameters = 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 (PState ledgerera
-> Map
     (KeyHash 'StakePool (EraCrypto ledgerera))
     (PoolParams (EraCrypto ledgerera))
forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
L.psStakePoolParams PState ledgerera
PState (ShelleyLedgerEra era)
poolState)
                        , futurePoolParameters :: Maybe (PoolParams StandardCrypto)
futurePoolParameters = 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 (PState ledgerera
-> Map
     (KeyHash 'StakePool (EraCrypto ledgerera))
     (PoolParams (EraCrypto ledgerera))
forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
L.psFutureStakePoolParams PState ledgerera
PState (ShelleyLedgerEra era)
poolState)
                        , retiringEpoch :: Maybe EpochNo
retiringEpoch = 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 (PState ledgerera
-> Map (KeyHash 'StakePool (EraCrypto ledgerera)) EpochNo
forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
L.psRetiring PState ledgerera
PState (ShelleyLedgerEra era)
poolState)
                        }
                    )
                )

  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
      Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto)
-> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map (KeyHash 'StakePool StandardCrypto) (Params StandardCrypto)
poolStates

writeProtocolState
  :: ShelleyBasedEra era
  -> Maybe (File () Out)
  -> ProtocolState era
  -> ExceptT QueryCmdError IO ()
writeProtocolState :: forall era.
ShelleyBasedEra era
-> Maybe (File () 'Out)
-> ProtocolState era
-> ExceptT QueryCmdError IO ()
writeProtocolState ShelleyBasedEra era
sbe Maybe (File () 'Out)
mOutFile ps :: ProtocolState era
ps@(ProtocolState Serialised (ChainDepState (ConsensusProtocol era))
pstate) =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      case Maybe (File () 'Out)
mOutFile of
        Maybe (File () 'Out)
Nothing -> ProtocolState era -> ExceptT QueryCmdError IO ()
forall {era}.
(FromCBOR (ChainDepState (ConsensusProtocol era)),
 ToJSON (ChainDepState (ConsensusProtocol era))) =>
ProtocolState era -> ExceptT QueryCmdError IO ()
decodePState ProtocolState era
ps
        Just (File String
fpath) -> String
-> Serialised (TPraosState StandardCrypto)
-> ExceptT QueryCmdError IO ()
forall {m :: * -> *} {a}.
MonadIO m =>
String -> Serialised a -> ExceptT QueryCmdError m ()
writePState String
fpath Serialised (ChainDepState (ConsensusProtocol era))
Serialised (TPraosState StandardCrypto)
pstate
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      case Maybe (File () 'Out)
mOutFile of
        Maybe (File () 'Out)
Nothing -> ProtocolState era -> ExceptT QueryCmdError IO ()
forall {era}.
(FromCBOR (ChainDepState (ConsensusProtocol era)),
 ToJSON (ChainDepState (ConsensusProtocol era))) =>
ProtocolState era -> ExceptT QueryCmdError IO ()
decodePState ProtocolState era
ps
        Just (File String
fpath) -> String
-> Serialised (TPraosState StandardCrypto)
-> ExceptT QueryCmdError IO ()
forall {m :: * -> *} {a}.
MonadIO m =>
String -> Serialised a -> ExceptT QueryCmdError m ()
writePState String
fpath Serialised (ChainDepState (ConsensusProtocol era))
Serialised (TPraosState StandardCrypto)
pstate
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      case Maybe (File () 'Out)
mOutFile of
        Maybe (File () 'Out)
Nothing -> ProtocolState era -> ExceptT QueryCmdError IO ()
forall {era}.
(FromCBOR (ChainDepState (ConsensusProtocol era)),
 ToJSON (ChainDepState (ConsensusProtocol era))) =>
ProtocolState era -> ExceptT QueryCmdError IO ()
decodePState ProtocolState era
ps
        Just (File String
fpath) -> String
-> Serialised (TPraosState StandardCrypto)
-> ExceptT QueryCmdError IO ()
forall {m :: * -> *} {a}.
MonadIO m =>
String -> Serialised a -> ExceptT QueryCmdError m ()
writePState String
fpath Serialised (ChainDepState (ConsensusProtocol era))
Serialised (TPraosState StandardCrypto)
pstate
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      case Maybe (File () 'Out)
mOutFile of
        Maybe (File () 'Out)
Nothing -> ProtocolState era -> ExceptT QueryCmdError IO ()
forall {era}.
(FromCBOR (ChainDepState (ConsensusProtocol era)),
 ToJSON (ChainDepState (ConsensusProtocol era))) =>
ProtocolState era -> ExceptT QueryCmdError IO ()
decodePState ProtocolState era
ps
        Just (File String
fpath) -> String
-> Serialised (TPraosState StandardCrypto)
-> ExceptT QueryCmdError IO ()
forall {m :: * -> *} {a}.
MonadIO m =>
String -> Serialised a -> ExceptT QueryCmdError m ()
writePState String
fpath Serialised (ChainDepState (ConsensusProtocol era))
Serialised (TPraosState StandardCrypto)
pstate
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      case Maybe (File () 'Out)
mOutFile of
        Maybe (File () 'Out)
Nothing -> ProtocolState era -> ExceptT QueryCmdError IO ()
forall {era}.
(FromCBOR (ChainDepState (ConsensusProtocol era)),
 ToJSON (ChainDepState (ConsensusProtocol era))) =>
ProtocolState era -> ExceptT QueryCmdError IO ()
decodePState ProtocolState era
ps
        Just (File String
fpath) -> String
-> Serialised (PraosState StandardCrypto)
-> ExceptT QueryCmdError IO ()
forall {m :: * -> *} {a}.
MonadIO m =>
String -> Serialised a -> ExceptT QueryCmdError m ()
writePState String
fpath Serialised (ChainDepState (ConsensusProtocol era))
Serialised (PraosState StandardCrypto)
pstate
    ShelleyBasedEra era
ShelleyBasedEraConway ->
      case Maybe (File () 'Out)
mOutFile of
        Maybe (File () 'Out)
Nothing -> ProtocolState era -> ExceptT QueryCmdError IO ()
forall {era}.
(FromCBOR (ChainDepState (ConsensusProtocol era)),
 ToJSON (ChainDepState (ConsensusProtocol era))) =>
ProtocolState era -> ExceptT QueryCmdError IO ()
decodePState ProtocolState era
ps
        Just (File String
fpath) -> String
-> Serialised (PraosState StandardCrypto)
-> ExceptT QueryCmdError IO ()
forall {m :: * -> *} {a}.
MonadIO m =>
String -> Serialised a -> ExceptT QueryCmdError m ()
writePState String
fpath Serialised (ChainDepState (ConsensusProtocol era))
Serialised (PraosState StandardCrypto)
pstate
 where
  writePState :: String -> Serialised a -> ExceptT QueryCmdError m ()
writePState String
fpath Serialised a
pstate' =
    (IOException -> QueryCmdError)
-> IO () -> ExceptT QueryCmdError m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> QueryCmdError
QueryCmdWriteFileError (FileError () -> QueryCmdError)
-> (IOException -> FileError ()) -> IOException -> QueryCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
      (IO () -> ExceptT QueryCmdError m ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT QueryCmdError m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString -> IO ()
LBS.writeFile String
fpath
      (ByteString -> ExceptT QueryCmdError m ())
-> ByteString -> ExceptT QueryCmdError m ()
forall a b. (a -> b) -> a -> b
$ Serialised a -> ByteString
forall {k} (a :: k). Serialised a -> ByteString
unSerialised Serialised a
pstate'
  decodePState :: ProtocolState era -> ExceptT QueryCmdError IO ()
decodePState ProtocolState era
ps' =
    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 -> QueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> QueryCmdError
QueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT QueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
      Right ChainDepState (ConsensusProtocol era)
chainDepstate -> IO () -> ExceptT QueryCmdError IO ()
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT QueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT QueryCmdError IO ())
-> ByteString -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ChainDepState (ConsensusProtocol era) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ChainDepState (ConsensusProtocol era)
chainDepstate

writeFilteredUTxOs
  :: Api.ShelleyBasedEra era
  -> Maybe OutputFormatJsonOrText
  -> Maybe (File () Out)
  -> UTxO era
  -> ExceptT QueryCmdError IO ()
writeFilteredUTxOs :: forall era.
ShelleyBasedEra era
-> Maybe OutputFormatJsonOrText
-> Maybe (File () 'Out)
-> UTxO era
-> ExceptT QueryCmdError IO ()
writeFilteredUTxOs ShelleyBasedEra era
sbe Maybe OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile UTxO era
utxo =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe
    ((ShelleyBasedEraConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ShelleyBasedEraConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (ByteString -> ExceptT (FileError ()) IO ())
-> ByteString
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> (ByteString -> IO (Either (FileError ()) ()))
-> ByteString
-> ExceptT (FileError ()) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile
    (ByteString -> ExceptT QueryCmdError IO ())
-> ByteString -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe OutputFormatJsonOrText
-> Maybe (File () 'Out) -> OutputFormatJsonOrText
forall a.
Maybe OutputFormatJsonOrText -> Maybe a -> OutputFormatJsonOrText
newOutputFormat Maybe OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile of
      OutputFormatJsonOrText
OutputFormatJson -> UTxO era -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty UTxO era
utxo
      OutputFormatJsonOrText
OutputFormatText -> Text -> ByteString
strictTextToLazyBytestring (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> UTxO era -> Text
forall era. ShelleyBasedEra era -> UTxO era -> Text
filteredUTxOsToText ShelleyBasedEra era
sbe UTxO era
utxo

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

utxoToText
  :: Api.ShelleyBasedEra era
  -> (TxIn, TxOut CtxUTxO era)
  -> Text
utxoToText :: forall era.
ShelleyBasedEra era -> (TxIn, TxOut CtxUTxO era) -> Text
utxoToText ShelleyBasedEra era
sbe (TxIn, TxOut CtxUTxO era)
txInOutTuple =
  case ShelleyBasedEra era
sbe 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] -> 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 Blake2b_256 EraIndependentTxBody
Hash StandardCrypto 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] -> 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 Blake2b_256 EraIndependentTxBody
Hash StandardCrypto 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] -> 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 Blake2b_256 EraIndependentTxBody
Hash StandardCrypto 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] -> 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 Blake2b_256 EraIndependentTxBody
Hash StandardCrypto 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. Show a => a -> String
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] -> 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 Blake2b_256 EraIndependentTxBody
Hash StandardCrypto 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. Show a => a -> String
show TxOutDatum CtxUTxO era
mDatum)
            ]
    ShelleyBasedEra era
ShelleyBasedEraConway ->
      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] -> 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 Blake2b_256 EraIndependentTxBody
Hash StandardCrypto 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. Show a => a -> String
show TxOutDatum CtxUTxO era
mDatum)
            ]
 where
  textShowN :: Show a => Int -> a -> Text
  textShowN :: forall a. Show a => Int -> a -> Text
textShowN Int
len a
x =
    let str :: String
str = a -> String
forall a. Show a => a -> String
show a
x
        slen :: Int
slen = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t 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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str

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

runQueryStakePoolsCmd
  :: ()
  => Cmd.QueryStakePoolsCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryStakePoolsCmd :: QueryStakePoolsCmdArgs -> ExceptT QueryCmdError IO ()
runQueryStakePoolsCmd
  Cmd.QueryStakePoolsCmdArgs
    { commons :: QueryStakePoolsCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe OutputFormatJsonOrText
format :: Maybe OutputFormatJsonOrText
format :: QueryStakePoolsCmdArgs -> Maybe OutputFormatJsonOrText
Cmd.format
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryStakePoolsCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT @QueryCmdError (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

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

            ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ OutputFormatJsonOrText
-> Maybe (File () 'Out)
-> Set PoolId
-> ExceptT QueryCmdError IO ()
writeStakePools (Maybe OutputFormatJsonOrText
-> Maybe (File () 'Out) -> OutputFormatJsonOrText
forall a.
Maybe OutputFormatJsonOrText -> Maybe a -> OutputFormatJsonOrText
newOutputFormat Maybe OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile) Maybe (File () 'Out)
mOutFile Set PoolId
poolIds
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

-- TODO: replace with writeFormattedOutput
writeStakePools
  :: OutputFormatJsonOrText
  -> Maybe (File () Out)
  -> Set PoolId
  -> ExceptT QueryCmdError IO ()
writeStakePools :: OutputFormatJsonOrText
-> Maybe (File () 'Out)
-> Set PoolId
-> ExceptT QueryCmdError IO ()
writeStakePools OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile Set PoolId
stakePools =
  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
toWrite
 where
  ByteString
toWrite :: LBS.ByteString =
    case OutputFormatJsonOrText
format of
      OutputFormatJsonOrText
OutputFormatText ->
        [ByteString] -> ByteString
LBS.unlines ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
          (PoolId -> ByteString) -> [PoolId] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ByteString
strictTextToLazyBytestring (Text -> ByteString) -> (PoolId -> Text) -> PoolId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolId -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32) ([PoolId] -> [ByteString]) -> [PoolId] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
            Set PoolId -> [Item (Set PoolId)]
forall l. IsList l => l -> [Item l]
toList Set PoolId
stakePools
      OutputFormatJsonOrText
OutputFormatJson ->
        Set PoolId -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Set PoolId
stakePools

writeFormattedOutput
  :: MonadIOTransError QueryCmdError t m
  => ToJSON a
  => Pretty a
  => Maybe OutputFormatJsonOrText
  -> Maybe (File b Out)
  -> a
  -> t m ()
writeFormattedOutput :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadIOTransError QueryCmdError t m, ToJSON a, Pretty a) =>
Maybe OutputFormatJsonOrText -> Maybe (File b 'Out) -> a -> t m ()
writeFormattedOutput Maybe OutputFormatJsonOrText
mFormat Maybe (File b 'Out)
mOutFile a
value =
  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) m () -> t m ()
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) m () -> t m ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) m ())
-> IO (Either (FileError ()) ())
-> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) m ()
forall e (t :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIOTransError e t m =>
IO (Either e a) -> t m a
hoistIOEither (IO (Either (FileError ()) ()) -> t m ())
-> IO (Either (FileError ()) ()) -> t m ()
forall a b. (a -> b) -> a -> b
$
    Maybe (File b 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File b 'Out)
mOutFile ByteString
toWrite
 where
  ByteString
toWrite :: LBS.ByteString =
    case Maybe OutputFormatJsonOrText
-> Maybe (File b 'Out) -> OutputFormatJsonOrText
forall a.
Maybe OutputFormatJsonOrText -> Maybe a -> OutputFormatJsonOrText
newOutputFormat Maybe OutputFormatJsonOrText
mFormat Maybe (File b 'Out)
mOutFile of
      OutputFormatJsonOrText
OutputFormatText -> String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString)
-> (Doc AnsiStyle -> String) -> Doc AnsiStyle -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> ByteString) -> Doc AnsiStyle -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Doc AnsiStyle
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
value
      OutputFormatJsonOrText
OutputFormatJson -> a -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty a
value

runQueryStakeDistributionCmd
  :: ()
  => Cmd.QueryStakeDistributionCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryStakeDistributionCmd :: QueryStakeDistributionCmdArgs -> ExceptT QueryCmdError IO ()
runQueryStakeDistributionCmd
  Cmd.QueryStakeDistributionCmdArgs
    { commons :: QueryStakeDistributionCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe OutputFormatJsonOrText
format :: Maybe OutputFormatJsonOrText
format :: QueryStakeDistributionCmdArgs -> Maybe OutputFormatJsonOrText
Cmd.format
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryStakeDistributionCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

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

            ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a.
a
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QueryCmdError IO ()
 -> ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO ()
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
forall a b. (a -> b) -> a -> b
$ do
              OutputFormatJsonOrText
-> Maybe (File () 'Out)
-> Map PoolId Rational
-> ExceptT QueryCmdError IO ()
writeStakeDistribution (Maybe OutputFormatJsonOrText
-> Maybe (File () 'Out) -> OutputFormatJsonOrText
forall a.
Maybe OutputFormatJsonOrText -> Maybe a -> OutputFormatJsonOrText
newOutputFormat Maybe OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile) Maybe (File () 'Out)
mOutFile Map PoolId Rational
result
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left

writeStakeDistribution
  :: OutputFormatJsonOrText
  -> Maybe (File () Out)
  -> Map PoolId Rational
  -> ExceptT QueryCmdError IO ()
writeStakeDistribution :: OutputFormatJsonOrText
-> Maybe (File () 'Out)
-> Map PoolId Rational
-> ExceptT QueryCmdError IO ()
writeStakeDistribution OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile Map PoolId Rational
stakeDistrib =
  (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
toWrite
 where
  ByteString
toWrite :: LBS.ByteString =
    case OutputFormatJsonOrText
format of
      OutputFormatJsonOrText
OutputFormatJson -> Map PoolId Rational -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map PoolId Rational
stakeDistrib
      OutputFormatJsonOrText
OutputFormatText -> Text -> ByteString
strictTextToLazyBytestring Text
stakeDistributionText
  stakeDistributionText :: Text
stakeDistributionText =
    [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
      [ Text
title
      , Int -> Text -> Text
Text.replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Text
"-"
      ]
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [PoolId -> Rational -> Text
showStakeDistr PoolId
poolId Rational
stakeFraction | (PoolId
poolId, Rational
stakeFraction) <- Map PoolId Rational -> [Item (Map PoolId Rational)]
forall l. IsList l => l -> [Item l]
toList Map PoolId Rational
stakeDistrib]
   where
    title :: Text
    title :: Text
title =
      Text
"                           PoolId                                 Stake frac"
    showStakeDistr :: PoolId -> Rational -> Text
    showStakeDistr :: PoolId -> Rational -> Text
showStakeDistr PoolId
poolId Rational
stakeFraction =
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ PoolId -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 PoolId
poolId
        , Text
"   "
        , String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
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
""
        ]

runQueryLeadershipScheduleCmd
  :: Cmd.QueryLeadershipScheduleCmdArgs
  -> ExceptT QueryCmdError IO ()
runQueryLeadershipScheduleCmd :: QueryLeadershipScheduleCmdArgs -> ExceptT QueryCmdError IO ()
runQueryLeadershipScheduleCmd
  Cmd.QueryLeadershipScheduleCmdArgs
    { commons :: QueryLeadershipScheduleCmdArgs -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , genesisFp :: QueryLeadershipScheduleCmdArgs -> GenesisFile
Cmd.genesisFp = GenesisFile String
genFile
    , VerificationKeyOrHashOrFile StakePoolKey
poolColdVerKeyFile :: VerificationKeyOrHashOrFile StakePoolKey
poolColdVerKeyFile :: QueryLeadershipScheduleCmdArgs
-> VerificationKeyOrHashOrFile StakePoolKey
Cmd.poolColdVerKeyFile
    , SigningKeyFile 'In
vrkSkeyFp :: SigningKeyFile 'In
vrkSkeyFp :: QueryLeadershipScheduleCmdArgs -> SigningKeyFile 'In
Cmd.vrkSkeyFp
    , EpochLeadershipSchedule
whichSchedule :: EpochLeadershipSchedule
whichSchedule :: QueryLeadershipScheduleCmdArgs -> EpochLeadershipSchedule
Cmd.whichSchedule
    , Maybe OutputFormatJsonOrText
format :: Maybe OutputFormatJsonOrText
format :: QueryLeadershipScheduleCmdArgs -> Maybe OutputFormatJsonOrText
Cmd.format
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: QueryLeadershipScheduleCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    PoolId
poolid <-
      (FileError InputDecodeError -> QueryCmdError)
-> ExceptT (FileError InputDecodeError) IO PoolId
-> ExceptT QueryCmdError IO PoolId
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> QueryCmdError
QueryCmdTextReadError (ExceptT (FileError InputDecodeError) IO PoolId
 -> ExceptT QueryCmdError IO PoolId)
-> ExceptT (FileError InputDecodeError) IO PoolId
-> ExceptT QueryCmdError IO PoolId
forall a b. (a -> b) -> a -> b
$
        AsType StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
-> ExceptT (FileError InputDecodeError) IO PoolId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m, Key keyrole,
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrHashOrFile StakePoolKey
poolColdVerKeyFile

    SigningKey VrfKey
vrkSkey <-
      (FileError TextEnvelopeError -> QueryCmdError)
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
-> ExceptT QueryCmdError IO (SigningKey VrfKey)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError TextEnvelopeError -> QueryCmdError
QueryCmdTextEnvelopeReadError (ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
 -> ExceptT QueryCmdError IO (SigningKey VrfKey))
-> (IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
    -> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey))
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT QueryCmdError IO (SigningKey VrfKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT (FileError TextEnvelopeError) IO (SigningKey VrfKey)
forall e (t :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIOTransError e t m =>
IO (Either e a) -> t m a
hoistIOEither (IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
 -> ExceptT QueryCmdError IO (SigningKey VrfKey))
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
-> ExceptT QueryCmdError IO (SigningKey VrfKey)
forall a b. (a -> b) -> a -> b
$
        AsType (SigningKey VrfKey)
-> SigningKeyFile 'In
-> IO (Either (FileError TextEnvelopeError) (SigningKey VrfKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType VrfKey -> AsType (SigningKey VrfKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VrfKey
AsVrfKey) SigningKeyFile 'In
vrkSkeyFp

    ShelleyGenesis StandardCrypto
shelleyGenesis <-
      (GenesisCmdError -> QueryCmdError)
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
-> ExceptT QueryCmdError IO (ShelleyGenesis StandardCrypto)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError GenesisCmdError -> QueryCmdError
QueryCmdGenesisReadError (ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
 -> ExceptT QueryCmdError IO (ShelleyGenesis StandardCrypto))
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
-> ExceptT QueryCmdError IO (ShelleyGenesis StandardCrypto)
forall a b. (a -> b) -> a -> b
$
        String
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
String -> t m (ShelleyGenesis StandardCrypto)
decodeShelleyGenesisFile String
genFile

    ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
        ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError (ExceptT QueryCmdError IO ()))
 -> IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ()))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   (ExceptT QueryCmdError IO ())
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ExceptT QueryCmdError IO ())
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. (a -> b) -> a -> b
$ do
            AnyCardanoEra CardanoEra era
era <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  AnyCardanoEra
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  AnyCardanoEra
easyRunQueryCurrentEra

            ShelleyBasedEra era
sbe <-
              CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra CardanoEra era
era
                ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (Maybe (ShelleyBasedEra era))
-> (ExceptT
      QueryCmdError
      (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
      (Maybe (ShelleyBasedEra era))
    -> ExceptT
         QueryCmdError
         (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
         (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall a b. a -> (a -> b) -> b
& ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  (ShelleyBasedEra era)
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (Maybe (ShelleyBasedEra era))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall x (m :: * -> *) a.
Monad m =>
ExceptT x m a -> ExceptT x m (Maybe a) -> ExceptT x m a
onNothing (QueryCmdError
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left QueryCmdError
QueryCmdByronEra)

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

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

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

            case EpochLeadershipSchedule
whichSchedule of
              EpochLeadershipSchedule
CurrentEpoch -> do
                BabbageEraOnwards era
beo <- CardanoEra BabbageEra
-> CardanoEra era
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     (BabbageEraOnwards era)
forall (eon :: * -> *) era minEra (m :: * -> *).
(Eon eon, Monad m) =>
CardanoEra minEra
-> CardanoEra era -> ExceptT QueryCmdError m (eon era)
requireEon CardanoEra BabbageEra
BabbageEra CardanoEra era
era

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

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

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

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

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

                  Maybe (File () 'Out)
-> EpochInfo (Either Text)
-> ShelleyGenesis StandardCrypto
-> Set SlotNo
-> ExceptT QueryCmdError IO ()
writeSchedule Maybe (File () 'Out)
mOutFile EpochInfo (Either Text)
eInfo ShelleyGenesis StandardCrypto
shelleyGenesis Set SlotNo
schedule
        )
        ExceptT
  QueryCmdError
  IO
  (Either
     AcquiringFailure
     (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (ExceptT
      QueryCmdError
      IO
      (Either
         AcquiringFailure
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
    -> ExceptT
         QueryCmdError
         IO
         (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall a b. a -> (a -> b) -> b
& (AcquiringFailure
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either
        AcquiringFailure
        (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError
 -> ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ())))
-> (AcquiringFailure -> QueryCmdError)
-> AcquiringFailure
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AcquiringFailure -> QueryCmdError
QueryCmdAcquireFailure)
        ExceptT
  QueryCmdError
  IO
  (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> (ExceptT
      QueryCmdError
      IO
      (Either QueryCmdError (ExceptT QueryCmdError IO ()))
    -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall a b. a -> (a -> b) -> b
& (QueryCmdError
 -> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ()))
-> ExceptT
     QueryCmdError
     IO
     (Either QueryCmdError (ExceptT QueryCmdError IO ()))
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft QueryCmdError
-> ExceptT QueryCmdError IO (ExceptT QueryCmdError IO ())
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left
   where
    writeSchedule :: Maybe (File () 'Out)
-> EpochInfo (Either Text)
-> ShelleyGenesis StandardCrypto
-> Set SlotNo
-> ExceptT QueryCmdError IO ()
writeSchedule Maybe (File () 'Out)
mOutFile' EpochInfo (Either Text)
eInfo ShelleyGenesis StandardCrypto
shelleyGenesis Set SlotNo
schedule =
      (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
        Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile' ByteString
toWrite
     where
      start :: SystemStart
start = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis StandardCrypto -> UTCTime
forall c. ShelleyGenesis c -> UTCTime
sgSystemStart ShelleyGenesis StandardCrypto
shelleyGenesis
      toWrite :: ByteString
toWrite =
        case Maybe OutputFormatJsonOrText
-> Maybe (File () 'Out) -> OutputFormatJsonOrText
forall a.
Maybe OutputFormatJsonOrText -> Maybe a -> OutputFormatJsonOrText
newOutputFormat Maybe OutputFormatJsonOrText
format Maybe (File () 'Out)
mOutFile' of
          OutputFormatJsonOrText
OutputFormatJson ->
            [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> [Value]
leadershipScheduleToJson Set SlotNo
schedule EpochInfo (Either Text)
eInfo SystemStart
start
          OutputFormatJsonOrText
OutputFormatText ->
            Text -> ByteString
strictTextToLazyBytestring (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Set SlotNo -> EpochInfo (Either Text) -> SystemStart -> Text
leadershipScheduleToText Set SlotNo
schedule EpochInfo (Either Text)
eInfo SystemStart
start

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

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

runQueryConstitution
  :: Cmd.QueryNoArgCmdArgs era
  -> ExceptT QueryCmdError IO ()
runQueryConstitution :: forall era. QueryNoArgCmdArgs era -> ExceptT QueryCmdError IO ()
runQueryConstitution
  Cmd.QueryNoArgCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. QueryNoArgCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryNoArgCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. QueryNoArgCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath
    Constitution (ShelleyLedgerEra era)
constitution <- LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
 -> ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (Constitution (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Constitution (ShelleyLedgerEra era))))
queryConstitution ConwayEraOnwards era
eon
    Maybe (File () 'Out)
-> Constitution (ShelleyLedgerEra era)
-> ExceptT QueryCmdError IO ()
forall b a.
ToJSON b =>
Maybe (File a 'Out) -> b -> ExceptT QueryCmdError IO ()
writeOutput Maybe (File () 'Out)
mOutFile Constitution (ShelleyLedgerEra era)
constitution

runQueryGovState
  :: Cmd.QueryNoArgCmdArgs era
  -> ExceptT QueryCmdError IO ()
runQueryGovState :: forall era. QueryNoArgCmdArgs era -> ExceptT QueryCmdError IO ()
runQueryGovState
  Cmd.QueryNoArgCmdArgs
    { ConwayEraOnwards era
eon :: forall era. QueryNoArgCmdArgs era -> ConwayEraOnwards era
eon :: ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryNoArgCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe (File () 'Out)
mOutFile :: forall era. QueryNoArgCmdArgs era -> Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath
    ConwayGovState (ShelleyLedgerEra era)
govState <- LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ConwayGovState (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (ConwayGovState (ShelleyLedgerEra era))))
 -> ExceptT
      QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (ConwayGovState (ShelleyLedgerEra era))))
-> ExceptT QueryCmdError IO (ConwayGovState (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GovState (ShelleyLedgerEra era))))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (GovState (ShelleyLedgerEra era))))
queryGovState ConwayEraOnwards era
eon
    Maybe (File () 'Out)
-> ConwayGovState (ShelleyLedgerEra era)
-> ExceptT QueryCmdError IO ()
forall b a.
ToJSON b =>
Maybe (File a 'Out) -> b -> ExceptT QueryCmdError IO ()
writeOutput Maybe (File () 'Out)
mOutFile ConwayGovState (ShelleyLedgerEra era)
govState

runQueryDRepState
  :: Cmd.QueryDRepStateCmdArgs era
  -> ExceptT QueryCmdError IO ()
runQueryDRepState :: forall era.
QueryDRepStateCmdArgs era -> ExceptT QueryCmdError IO ()
runQueryDRepState
  Cmd.QueryDRepStateCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. QueryDRepStateCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , drepHashSources :: forall era. QueryDRepStateCmdArgs era -> AllOrOnly DRepHashSource
Cmd.drepHashSources = AllOrOnly DRepHashSource
drepHashSources'
    , IncludeStake
includeStake :: IncludeStake
includeStake :: forall era. QueryDRepStateCmdArgs era -> IncludeStake
Cmd.includeStake
    , commons :: forall era. QueryDRepStateCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. QueryDRepStateCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    let drepHashSources :: [DRepHashSource]
drepHashSources = case AllOrOnly DRepHashSource
drepHashSources' of AllOrOnly DRepHashSource
All -> []; Only [DRepHashSource]
l -> [DRepHashSource]
l
    [Credential 'DRepRole StandardCrypto]
drepCreds <- (FileError InputDecodeError -> QueryCmdError)
-> ExceptT
     (FileError InputDecodeError)
     IO
     [Credential 'DRepRole StandardCrypto]
-> ExceptT QueryCmdError IO [Credential 'DRepRole StandardCrypto]
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> QueryCmdError
QueryCmdDRepKeyError (ExceptT
   (FileError InputDecodeError)
   IO
   [Credential 'DRepRole StandardCrypto]
 -> ExceptT QueryCmdError IO [Credential 'DRepRole StandardCrypto])
-> ExceptT
     (FileError InputDecodeError)
     IO
     [Credential 'DRepRole StandardCrypto]
-> ExceptT QueryCmdError IO [Credential 'DRepRole StandardCrypto]
forall a b. (a -> b) -> a -> b
$ (DRepHashSource
 -> ExceptT
      (FileError InputDecodeError)
      IO
      (Credential 'DRepRole StandardCrypto))
-> [DRepHashSource]
-> ExceptT
     (FileError InputDecodeError)
     IO
     [Credential 'DRepRole StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DRepHashSource
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'DRepRole StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError InputDecodeError) t m =>
DRepHashSource -> t m (Credential 'DRepRole StandardCrypto)
readDRepCredential [DRepHashSource]
drepHashSources

    Map
  (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
drepState <- LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
-> ExceptT
     QueryCmdError
     IO
     (Map
        (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either
         EraMismatch
         (Map
            (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
 -> ExceptT
      QueryCmdError
      IO
      (Map
         (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
-> ExceptT
     QueryCmdError
     IO
     (Map
        (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set (Credential 'DRepRole StandardCrypto)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
forall era block point r.
ConwayEraOnwards era
-> Set (Credential 'DRepRole StandardCrypto)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
queryDRepState ConwayEraOnwards era
eon (Set (Credential 'DRepRole StandardCrypto)
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either
         UnsupportedNtcVersionError
         (Either
            EraMismatch
            (Map
               (Credential 'DRepRole StandardCrypto)
               (DRepState StandardCrypto)))))
-> Set (Credential 'DRepRole StandardCrypto)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch
           (Map
              (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))))
forall a b. (a -> b) -> a -> b
$ [Item (Set (Credential 'DRepRole StandardCrypto))]
-> Set (Credential 'DRepRole StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList [Item (Set (Credential 'DRepRole StandardCrypto))]
[Credential 'DRepRole StandardCrypto]
drepCreds

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

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

    Maybe (File () 'Out)
-> [QueryDRepStateOutput] -> ExceptT QueryCmdError IO ()
forall b a.
ToJSON b =>
Maybe (File a 'Out) -> b -> ExceptT QueryCmdError IO ()
writeOutput Maybe (File () 'Out)
mOutFile [QueryDRepStateOutput]
toWrite
   where
    toDRepStateOutput
      :: ()
      => Map (L.DRep StandardCrypto) Lovelace
      -> (L.Credential L.DRepRole StandardCrypto, L.DRepState StandardCrypto)
      -> QueryDRepStateOutput
    toDRepStateOutput :: Map (DRep StandardCrypto) Lovelace
-> (Credential 'DRepRole StandardCrypto, DRepState StandardCrypto)
-> QueryDRepStateOutput
toDRepStateOutput Map (DRep StandardCrypto) Lovelace
stakeDistr (Credential 'DRepRole StandardCrypto
cred, DRepState StandardCrypto
ds) =
      Credential 'DRepRole StandardCrypto
-> EpochNo
-> Maybe (Anchor StandardCrypto)
-> Lovelace
-> IncludeStake
-> Maybe Lovelace
-> QueryDRepStateOutput
QueryDRepStateOutput
        Credential 'DRepRole StandardCrypto
cred
        (DRepState StandardCrypto
ds DRepState StandardCrypto
-> Getting EpochNo (DRepState StandardCrypto) EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo (DRepState StandardCrypto) EpochNo
forall c (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> DRepState c -> f (DRepState c)
L.drepExpiryL)
        (StrictMaybe (Anchor StandardCrypto)
-> Maybe (Anchor StandardCrypto)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (StrictMaybe (Anchor StandardCrypto)
 -> Maybe (Anchor StandardCrypto))
-> StrictMaybe (Anchor StandardCrypto)
-> Maybe (Anchor StandardCrypto)
forall a b. (a -> b) -> a -> b
$ DRepState StandardCrypto
ds DRepState StandardCrypto
-> Getting
     (StrictMaybe (Anchor StandardCrypto))
     (DRepState StandardCrypto)
     (StrictMaybe (Anchor StandardCrypto))
-> StrictMaybe (Anchor StandardCrypto)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Anchor StandardCrypto))
  (DRepState StandardCrypto)
  (StrictMaybe (Anchor StandardCrypto))
forall c (f :: * -> *).
Functor f =>
(StrictMaybe (Anchor c) -> f (StrictMaybe (Anchor c)))
-> DRepState c -> f (DRepState c)
L.drepAnchorL)
        (DRepState StandardCrypto
ds DRepState StandardCrypto
-> Getting Lovelace (DRepState StandardCrypto) Lovelace -> Lovelace
forall s a. s -> Getting a s a -> a
^. Getting Lovelace (DRepState StandardCrypto) Lovelace
forall c (f :: * -> *).
Functor f =>
(Lovelace -> f Lovelace) -> DRepState c -> f (DRepState c)
L.drepDepositL)
        IncludeStake
includeStake
        (DRep StandardCrypto
-> Map (DRep StandardCrypto) Lovelace -> Maybe Lovelace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Credential 'DRepRole StandardCrypto -> DRep StandardCrypto
forall c. Credential 'DRepRole c -> DRep c
L.DRepCredential Credential 'DRepRole StandardCrypto
cred) Map (DRep StandardCrypto) Lovelace
stakeDistr)

runQueryDRepStakeDistribution
  :: Cmd.QueryDRepStakeDistributionCmdArgs era
  -> ExceptT QueryCmdError IO ()
runQueryDRepStakeDistribution :: forall era.
QueryDRepStakeDistributionCmdArgs era
-> ExceptT QueryCmdError IO ()
runQueryDRepStakeDistribution
  Cmd.QueryDRepStakeDistributionCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
QueryDRepStakeDistributionCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryDRepStakeDistributionCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , drepHashSources :: forall era.
QueryDRepStakeDistributionCmdArgs era -> AllOrOnly DRepHashSource
Cmd.drepHashSources = AllOrOnly DRepHashSource
drepHashSources'
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era.
QueryDRepStakeDistributionCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    let drepFromSource :: DRepHashSource -> ExceptT QueryCmdError IO (DRep StandardCrypto)
drepFromSource =
          (Credential 'DRepRole StandardCrypto -> DRep StandardCrypto)
-> ExceptT QueryCmdError IO (Credential 'DRepRole StandardCrypto)
-> ExceptT QueryCmdError IO (DRep StandardCrypto)
forall a b.
(a -> b)
-> ExceptT QueryCmdError IO a -> ExceptT QueryCmdError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Credential 'DRepRole StandardCrypto -> DRep StandardCrypto
forall c. Credential 'DRepRole c -> DRep c
L.DRepCredential
            (ExceptT QueryCmdError IO (Credential 'DRepRole StandardCrypto)
 -> ExceptT QueryCmdError IO (DRep StandardCrypto))
-> (DRepHashSource
    -> ExceptT QueryCmdError IO (Credential 'DRepRole StandardCrypto))
-> DRepHashSource
-> ExceptT QueryCmdError IO (DRep StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileError InputDecodeError -> QueryCmdError)
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'DRepRole StandardCrypto)
-> ExceptT QueryCmdError IO (Credential 'DRepRole StandardCrypto)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> QueryCmdError
QueryCmdDRepKeyError
            (ExceptT
   (FileError InputDecodeError)
   IO
   (Credential 'DRepRole StandardCrypto)
 -> ExceptT QueryCmdError IO (Credential 'DRepRole StandardCrypto))
-> (DRepHashSource
    -> ExceptT
         (FileError InputDecodeError)
         IO
         (Credential 'DRepRole StandardCrypto))
-> DRepHashSource
-> ExceptT QueryCmdError IO (Credential 'DRepRole StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepHashSource
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'DRepRole StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError InputDecodeError) t m =>
DRepHashSource -> t m (Credential 'DRepRole StandardCrypto)
readDRepCredential
        drepHashSources :: [DRepHashSource]
drepHashSources = case AllOrOnly DRepHashSource
drepHashSources' of
          AllOrOnly DRepHashSource
All -> []
          Only [DRepHashSource]
l -> [DRepHashSource]
l
    Set (DRep StandardCrypto)
dreps <- [Item (Set (DRep StandardCrypto))] -> Set (DRep StandardCrypto)
[DRep StandardCrypto] -> Set (DRep StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList ([DRep StandardCrypto] -> Set (DRep StandardCrypto))
-> ExceptT QueryCmdError IO [DRep StandardCrypto]
-> ExceptT QueryCmdError IO (Set (DRep StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DRepHashSource -> ExceptT QueryCmdError IO (DRep StandardCrypto))
-> [DRepHashSource]
-> ExceptT QueryCmdError IO [DRep StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DRepHashSource -> ExceptT QueryCmdError IO (DRep StandardCrypto)
drepFromSource [DRepHashSource]
drepHashSources

    Map (DRep StandardCrypto) Lovelace
drepStakeDistribution <- LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (DRep StandardCrypto) Lovelace)))
-> ExceptT QueryCmdError IO (Map (DRep StandardCrypto) Lovelace)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Map (DRep StandardCrypto) Lovelace)))
 -> ExceptT QueryCmdError IO (Map (DRep StandardCrypto) Lovelace))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (DRep StandardCrypto) Lovelace)))
-> ExceptT QueryCmdError IO (Map (DRep StandardCrypto) Lovelace)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set (DRep StandardCrypto)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (DRep StandardCrypto) Lovelace)))
forall era block point r.
ConwayEraOnwards era
-> Set (DRep StandardCrypto)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Map (DRep StandardCrypto) Lovelace)))
queryDRepStakeDistribution ConwayEraOnwards era
eon Set (DRep StandardCrypto)
dreps
    Maybe (File () 'Out)
-> [(DRep StandardCrypto, Lovelace)] -> ExceptT QueryCmdError IO ()
forall b a.
ToJSON b =>
Maybe (File a 'Out) -> b -> ExceptT QueryCmdError IO ()
writeOutput Maybe (File () 'Out)
mOutFile ([(DRep StandardCrypto, Lovelace)] -> ExceptT QueryCmdError IO ())
-> [(DRep StandardCrypto, Lovelace)] -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      Map (DRep StandardCrypto) Lovelace
-> [(DRep StandardCrypto, Lovelace)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map (DRep StandardCrypto) Lovelace
drepStakeDistribution

runQuerySPOStakeDistribution
  :: Cmd.QuerySPOStakeDistributionCmdArgs era
  -> ExceptT QueryCmdError IO ()
runQuerySPOStakeDistribution :: forall era.
QuerySPOStakeDistributionCmdArgs era -> ExceptT QueryCmdError IO ()
runQuerySPOStakeDistribution
  Cmd.QuerySPOStakeDistributionCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
QuerySPOStakeDistributionCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QuerySPOStakeDistributionCmdArgs era -> QueryCommons
Cmd.commons =
      commons :: QueryCommons
commons@Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , spoHashSources :: forall era.
QuerySPOStakeDistributionCmdArgs era -> AllOrOnly SPOHashSource
Cmd.spoHashSources = AllOrOnly SPOHashSource
spoHashSources'
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era.
QuerySPOStakeDistributionCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath
        spoFromSource :: SPOHashSource
-> ExceptT QueryCmdError IO (KeyHash 'StakePool StandardCrypto)
spoFromSource = (FileError InputDecodeError -> QueryCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (KeyHash 'StakePool StandardCrypto)
-> ExceptT QueryCmdError IO (KeyHash 'StakePool StandardCrypto)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> QueryCmdError
QueryCmdSPOKeyError (ExceptT
   (FileError InputDecodeError) IO (KeyHash 'StakePool StandardCrypto)
 -> ExceptT QueryCmdError IO (KeyHash 'StakePool StandardCrypto))
-> (SPOHashSource
    -> ExceptT
         (FileError InputDecodeError)
         IO
         (KeyHash 'StakePool StandardCrypto))
-> SPOHashSource
-> ExceptT QueryCmdError IO (KeyHash 'StakePool StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPOHashSource
-> ExceptT
     (FileError InputDecodeError) IO (KeyHash 'StakePool StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError InputDecodeError) t m =>
SPOHashSource -> t m (KeyHash 'StakePool StandardCrypto)
readSPOCredential
        spoHashSources :: [SPOHashSource]
spoHashSources = case AllOrOnly SPOHashSource
spoHashSources' of
          AllOrOnly SPOHashSource
All -> []
          Only [SPOHashSource]
l -> [SPOHashSource]
l

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

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

    Map (KeyHash 'StakePool StandardCrypto) Lovelace
spoStakeDistribution :: Map (L.KeyHash L.StakePool StandardCrypto) L.Coin <-
      LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map (KeyHash 'StakePool StandardCrypto) Lovelace)))
-> ExceptT
     QueryCmdError IO (Map (KeyHash 'StakePool StandardCrypto) Lovelace)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either
         EraMismatch (Map (KeyHash 'StakePool StandardCrypto) Lovelace)))
 -> ExceptT
      QueryCmdError
      IO
      (Map (KeyHash 'StakePool StandardCrypto) Lovelace))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map (KeyHash 'StakePool StandardCrypto) Lovelace)))
-> ExceptT
     QueryCmdError IO (Map (KeyHash 'StakePool StandardCrypto) Lovelace)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set (KeyHash 'StakePool StandardCrypto)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map (KeyHash 'StakePool StandardCrypto) Lovelace)))
forall era block point r.
ConwayEraOnwards era
-> Set (KeyHash 'StakePool StandardCrypto)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either
           EraMismatch (Map (KeyHash 'StakePool StandardCrypto) Lovelace)))
querySPOStakeDistribution ConwayEraOnwards era
eon Set (KeyHash 'StakePool StandardCrypto)
spos
    let Set PoolId
poolIds :: Set (Hash StakePoolKey) = [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList ([PoolId] -> Set PoolId) -> [PoolId] -> Set PoolId
forall a b. (a -> b) -> a -> b
$ (KeyHash 'StakePool StandardCrypto -> PoolId)
-> [KeyHash 'StakePool StandardCrypto] -> [PoolId]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'StakePool StandardCrypto -> PoolId
StakePoolKeyHash ([KeyHash 'StakePool StandardCrypto] -> [PoolId])
-> [KeyHash 'StakePool StandardCrypto] -> [PoolId]
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'StakePool StandardCrypto) Lovelace
-> [KeyHash 'StakePool StandardCrypto]
forall k a. Map k a -> [k]
Map.keys Map (KeyHash 'StakePool StandardCrypto) Lovelace
spoStakeDistribution

    SerialisedPoolState era
serialisedPoolState :: SerialisedPoolState era <-
      LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolState era)))
-> ExceptT QueryCmdError IO (SerialisedPoolState era)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (SerialisedPoolState era)))
 -> ExceptT QueryCmdError IO (SerialisedPoolState era))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolState era)))
-> ExceptT QueryCmdError IO (SerialisedPoolState era)
forall a b. (a -> b) -> a -> b
$ BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolState era)))
forall era block point r.
BabbageEraOnwards era
-> Maybe (Set PoolId)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (SerialisedPoolState era)))
queryPoolState BabbageEraOnwards era
beo (Set PoolId -> Maybe (Set PoolId)
forall a. a -> Maybe a
Just Set PoolId
poolIds)

    PoolState (PState (ShelleyLedgerEra era)
poolState :: L.PState (ShelleyLedgerEra era)) <-
      Either DecoderError (PoolState era)
-> ExceptT QueryCmdError IO (Either DecoderError (PoolState era))
forall a. a -> ExceptT QueryCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SerialisedPoolState era -> Either DecoderError (PoolState era)
forall era.
(Era (ShelleyLedgerEra era),
 DecCBOR (PState (ShelleyLedgerEra era))) =>
SerialisedPoolState era -> Either DecoderError (PoolState era)
decodePoolState SerialisedPoolState era
serialisedPoolState)
        ExceptT QueryCmdError IO (Either DecoderError (PoolState era))
-> (ExceptT QueryCmdError IO (Either DecoderError (PoolState era))
    -> ExceptT QueryCmdError IO (PoolState era))
-> ExceptT QueryCmdError IO (PoolState era)
forall a b. a -> (a -> b) -> b
& (DecoderError -> ExceptT QueryCmdError IO (PoolState era))
-> ExceptT QueryCmdError IO (Either DecoderError (PoolState era))
-> ExceptT QueryCmdError IO (PoolState era)
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (QueryCmdError -> ExceptT QueryCmdError IO (PoolState era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (QueryCmdError -> ExceptT QueryCmdError IO (PoolState era))
-> (DecoderError -> QueryCmdError)
-> DecoderError
-> ExceptT QueryCmdError IO (PoolState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> QueryCmdError
QueryCmdPoolStateDecodeError)

    let Map StakeAddress (KeyHash 'StakePool StandardCrypto)
addressesAndRewards
          :: Map
              StakeAddress
              (L.KeyHash L.StakePool StandardCrypto) =
            [(StakeAddress, KeyHash 'StakePool StandardCrypto)]
-> Map StakeAddress (KeyHash 'StakePool StandardCrypto)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ ( NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
networkId (StakeCredential -> StakeAddress)
-> (PoolParams StandardCrypto -> StakeCredential)
-> PoolParams StandardCrypto
-> StakeAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential (StakeCredential StandardCrypto -> StakeCredential)
-> (PoolParams StandardCrypto -> StakeCredential StandardCrypto)
-> PoolParams StandardCrypto
-> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount StandardCrypto -> StakeCredential StandardCrypto
forall c. RewardAccount c -> Credential 'Staking c
L.raCredential (RewardAccount StandardCrypto -> StakeCredential StandardCrypto)
-> (PoolParams StandardCrypto -> RewardAccount StandardCrypto)
-> PoolParams StandardCrypto
-> StakeCredential StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams StandardCrypto -> RewardAccount StandardCrypto
forall c. PoolParams c -> RewardAccount c
L.ppRewardAccount (PoolParams StandardCrypto -> StakeAddress)
-> PoolParams StandardCrypto -> StakeAddress
forall a b. (a -> b) -> a -> b
$ PoolParams StandardCrypto
addr
                , KeyHash 'StakePool StandardCrypto
keyHash
                )
              | (KeyHash 'StakePool StandardCrypto
keyHash, PoolParams StandardCrypto
addr) <- Map (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map
   (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
 -> [(KeyHash 'StakePool StandardCrypto,
      PoolParams StandardCrypto)])
-> Map
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ PState (ShelleyLedgerEra era)
-> Map
     (KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era)))
     (PoolParams (EraCrypto (ShelleyLedgerEra era)))
forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
L.psStakePoolParams PState (ShelleyLedgerEra era)
poolState
              ]

        mkQueryStakeAddressInfoCmdArgs :: StakeAddress -> QueryStakeAddressInfoCmdArgs
mkQueryStakeAddressInfoCmdArgs StakeAddress
addr =
          Cmd.QueryStakeAddressInfoCmdArgs
            { commons :: QueryCommons
Cmd.commons = QueryCommons
commons
            , StakeAddress
addr :: StakeAddress
addr :: StakeAddress
addr
            , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile -- unused anyway. TODO tighten this by removing the field.
            }

    Map (KeyHash 'StakePool StandardCrypto) (DRep StandardCrypto)
spoToDelegatee <-
      [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]
-> Map (KeyHash 'StakePool StandardCrypto) (DRep StandardCrypto)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]
 -> Map (KeyHash 'StakePool StandardCrypto) (DRep StandardCrypto))
-> ([[(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]]
    -> [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)])
-> [[(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]]
-> Map (KeyHash 'StakePool StandardCrypto) (DRep StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]]
-> [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        ([[(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]]
 -> Map (KeyHash 'StakePool StandardCrypto) (DRep StandardCrypto))
-> ExceptT
     QueryCmdError
     IO
     [[(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]]
-> ExceptT
     QueryCmdError
     IO
     (Map (KeyHash 'StakePool StandardCrypto) (DRep StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StakeAddress
 -> ExceptT
      QueryCmdError
      IO
      [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)])
-> [StakeAddress]
-> ExceptT
     QueryCmdError
     IO
     [[(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
          ( \StakeAddress
stakeAddr -> do
              StakeAddressInfoData
info <- QueryStakeAddressInfoCmdArgs
-> ExceptT QueryCmdError IO StakeAddressInfoData
callQueryStakeAddressInfoCmd (QueryStakeAddressInfoCmdArgs
 -> ExceptT QueryCmdError IO StakeAddressInfoData)
-> QueryStakeAddressInfoCmdArgs
-> ExceptT QueryCmdError IO StakeAddressInfoData
forall a b. (a -> b) -> a -> b
$ StakeAddress -> QueryStakeAddressInfoCmdArgs
mkQueryStakeAddressInfoCmdArgs StakeAddress
stakeAddr
              [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]
-> ExceptT
     QueryCmdError
     IO
     [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]
forall a. a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]
 -> ExceptT
      QueryCmdError
      IO
      [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)])
-> [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]
-> ExceptT
     QueryCmdError
     IO
     [(KeyHash 'StakePool StandardCrypto, DRep StandardCrypto)]
forall a b. (a -> b) -> a -> b
$
                [ (KeyHash 'StakePool StandardCrypto
spo, DRep StandardCrypto
delegatee)
                | (Just KeyHash 'StakePool StandardCrypto
spo, DRep StandardCrypto
delegatee) <-
                    ((StakeAddress, DRep StandardCrypto)
 -> (Maybe (KeyHash 'StakePool StandardCrypto),
     DRep StandardCrypto))
-> [(StakeAddress, DRep StandardCrypto)]
-> [(Maybe (KeyHash 'StakePool StandardCrypto),
     DRep StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map ((StakeAddress -> Maybe (KeyHash 'StakePool StandardCrypto))
-> (StakeAddress, DRep StandardCrypto)
-> (Maybe (KeyHash 'StakePool StandardCrypto), DRep StandardCrypto)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (StakeAddress
-> Map StakeAddress (KeyHash 'StakePool StandardCrypto)
-> Maybe (KeyHash 'StakePool StandardCrypto)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map StakeAddress (KeyHash 'StakePool StandardCrypto)
addressesAndRewards)) ([(StakeAddress, DRep StandardCrypto)]
 -> [(Maybe (KeyHash 'StakePool StandardCrypto),
      DRep StandardCrypto)])
-> [(StakeAddress, DRep StandardCrypto)]
-> [(Maybe (KeyHash 'StakePool StandardCrypto),
     DRep StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ Map StakeAddress (DRep StandardCrypto)
-> [(StakeAddress, DRep StandardCrypto)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map StakeAddress (DRep StandardCrypto)
 -> [(StakeAddress, DRep StandardCrypto)])
-> Map StakeAddress (DRep StandardCrypto)
-> [(StakeAddress, DRep StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ StakeAddressInfoData -> Map StakeAddress (DRep StandardCrypto)
delegatees StakeAddressInfoData
info
                ]
          )
          (Map StakeAddress (KeyHash 'StakePool StandardCrypto)
-> [StakeAddress]
forall k a. Map k a -> [k]
Map.keys Map StakeAddress (KeyHash 'StakePool StandardCrypto)
addressesAndRewards)

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

    Maybe (File () 'Out)
-> [(KeyHash 'StakePool StandardCrypto, Lovelace,
     Maybe (DRep StandardCrypto))]
-> ExceptT QueryCmdError IO ()
forall b a.
ToJSON b =>
Maybe (File a 'Out) -> b -> ExceptT QueryCmdError IO ()
writeOutput Maybe (File () 'Out)
mOutFile [(KeyHash 'StakePool StandardCrypto, Lovelace,
  Maybe (DRep StandardCrypto))]
toWrite

runQueryCommitteeMembersState
  :: Cmd.QueryCommitteeMembersStateCmdArgs era
  -> ExceptT QueryCmdError IO ()
runQueryCommitteeMembersState :: forall era.
QueryCommitteeMembersStateCmdArgs era
-> ExceptT QueryCmdError IO ()
runQueryCommitteeMembersState
  Cmd.QueryCommitteeMembersStateCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
QueryCommitteeMembersStateCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryCommitteeMembersStateCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , committeeColdKeys :: forall era.
QueryCommitteeMembersStateCmdArgs era
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
Cmd.committeeColdKeys = [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
coldCredKeys
    , committeeHotKeys :: forall era.
QueryCommitteeMembersStateCmdArgs era
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey]
Cmd.committeeHotKeys = [VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey]
hotCredKeys
    , memberStatuses :: forall era. QueryCommitteeMembersStateCmdArgs era -> [MemberStatus]
Cmd.memberStatuses = [MemberStatus]
memberStatuses
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era.
QueryCommitteeMembersStateCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    let coldKeysFromVerKeyHashOrFile :: VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
     QueryCmdError IO (Credential 'ColdCommitteeRole StandardCrypto)
coldKeysFromVerKeyHashOrFile =
          (FileError InputDecodeError -> QueryCmdError)
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'ColdCommitteeRole StandardCrypto)
-> ExceptT
     QueryCmdError IO (Credential 'ColdCommitteeRole StandardCrypto)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> QueryCmdError
QueryCmdCommitteeColdKeyError
            (ExceptT
   (FileError InputDecodeError)
   IO
   (Credential 'ColdCommitteeRole StandardCrypto)
 -> ExceptT
      QueryCmdError IO (Credential 'ColdCommitteeRole StandardCrypto))
-> (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
    -> ExceptT
         (FileError InputDecodeError)
         IO
         (Credential 'ColdCommitteeRole StandardCrypto))
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
     QueryCmdError IO (Credential 'ColdCommitteeRole StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType CommitteeColdKey
-> (Hash CommitteeColdKey
    -> KeyHash 'ColdCommitteeRole StandardCrypto)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'ColdCommitteeRole StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
       (kr :: KeyRole).
(MonadIOTransError (FileError InputDecodeError) t m,
 Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr StandardCrypto)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> t m (Credential kr StandardCrypto)
readVerificationKeyOrHashOrFileOrScriptHash AsType CommitteeColdKey
AsCommitteeColdKey Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole StandardCrypto
unCommitteeColdKeyHash
    Set (Credential 'ColdCommitteeRole StandardCrypto)
coldKeys <- [Item (Set (Credential 'ColdCommitteeRole StandardCrypto))]
-> Set (Credential 'ColdCommitteeRole StandardCrypto)
[Credential 'ColdCommitteeRole StandardCrypto]
-> Set (Credential 'ColdCommitteeRole StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList ([Credential 'ColdCommitteeRole StandardCrypto]
 -> Set (Credential 'ColdCommitteeRole StandardCrypto))
-> ExceptT
     QueryCmdError IO [Credential 'ColdCommitteeRole StandardCrypto]
-> ExceptT
     QueryCmdError
     IO
     (Set (Credential 'ColdCommitteeRole StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
 -> ExceptT
      QueryCmdError IO (Credential 'ColdCommitteeRole StandardCrypto))
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
-> ExceptT
     QueryCmdError IO [Credential 'ColdCommitteeRole StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
     QueryCmdError IO (Credential 'ColdCommitteeRole StandardCrypto)
coldKeysFromVerKeyHashOrFile [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
coldCredKeys

    let hotKeysFromVerKeyHashOrFile :: VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> ExceptT
     QueryCmdError IO (Credential 'HotCommitteeRole StandardCrypto)
hotKeysFromVerKeyHashOrFile =
          (FileError InputDecodeError -> QueryCmdError)
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'HotCommitteeRole StandardCrypto)
-> ExceptT
     QueryCmdError IO (Credential 'HotCommitteeRole StandardCrypto)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> QueryCmdError
QueryCmdCommitteeHotKeyError
            (ExceptT
   (FileError InputDecodeError)
   IO
   (Credential 'HotCommitteeRole StandardCrypto)
 -> ExceptT
      QueryCmdError IO (Credential 'HotCommitteeRole StandardCrypto))
-> (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
    -> ExceptT
         (FileError InputDecodeError)
         IO
         (Credential 'HotCommitteeRole StandardCrypto))
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> ExceptT
     QueryCmdError IO (Credential 'HotCommitteeRole StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType CommitteeHotKey
-> (Hash CommitteeHotKey
    -> KeyHash 'HotCommitteeRole StandardCrypto)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'HotCommitteeRole StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
       (kr :: KeyRole).
(MonadIOTransError (FileError InputDecodeError) t m,
 Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr StandardCrypto)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> t m (Credential kr StandardCrypto)
readVerificationKeyOrHashOrFileOrScriptHash AsType CommitteeHotKey
AsCommitteeHotKey Hash CommitteeHotKey -> KeyHash 'HotCommitteeRole StandardCrypto
unCommitteeHotKeyHash
    Set (Credential 'HotCommitteeRole StandardCrypto)
hotKeys <- [Item (Set (Credential 'HotCommitteeRole StandardCrypto))]
-> Set (Credential 'HotCommitteeRole StandardCrypto)
[Credential 'HotCommitteeRole StandardCrypto]
-> Set (Credential 'HotCommitteeRole StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList ([Credential 'HotCommitteeRole StandardCrypto]
 -> Set (Credential 'HotCommitteeRole StandardCrypto))
-> ExceptT
     QueryCmdError IO [Credential 'HotCommitteeRole StandardCrypto]
-> ExceptT
     QueryCmdError
     IO
     (Set (Credential 'HotCommitteeRole StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
 -> ExceptT
      QueryCmdError IO (Credential 'HotCommitteeRole StandardCrypto))
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey]
-> ExceptT
     QueryCmdError IO [Credential 'HotCommitteeRole StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> ExceptT
     QueryCmdError IO (Credential 'HotCommitteeRole StandardCrypto)
hotKeysFromVerKeyHashOrFile [VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey]
hotCredKeys

    CommitteeMembersState StandardCrypto
committeeState <-
      LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (CommitteeMembersState StandardCrypto)))
-> ExceptT QueryCmdError IO (CommitteeMembersState StandardCrypto)
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (CommitteeMembersState StandardCrypto)))
 -> ExceptT QueryCmdError IO (CommitteeMembersState StandardCrypto))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (CommitteeMembersState StandardCrypto)))
-> ExceptT QueryCmdError IO (CommitteeMembersState StandardCrypto)
forall a b. (a -> b) -> a -> b
$
        ConwayEraOnwards era
-> Set (Credential 'ColdCommitteeRole StandardCrypto)
-> Set (Credential 'HotCommitteeRole StandardCrypto)
-> Set MemberStatus
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (CommitteeMembersState StandardCrypto)))
forall era block point r.
ConwayEraOnwards era
-> Set (Credential 'ColdCommitteeRole StandardCrypto)
-> Set (Credential 'HotCommitteeRole StandardCrypto)
-> Set MemberStatus
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (CommitteeMembersState StandardCrypto)))
queryCommitteeMembersState ConwayEraOnwards era
eon Set (Credential 'ColdCommitteeRole StandardCrypto)
coldKeys Set (Credential 'HotCommitteeRole StandardCrypto)
hotKeys ([Item (Set MemberStatus)] -> Set MemberStatus
forall l. IsList l => [Item l] -> l
fromList [Item (Set MemberStatus)]
[MemberStatus]
memberStatuses)
    Maybe (File () 'Out) -> Value -> ExceptT QueryCmdError IO ()
forall b a.
ToJSON b =>
Maybe (File a 'Out) -> b -> ExceptT QueryCmdError IO ()
writeOutput Maybe (File () 'Out)
mOutFile (Value -> ExceptT QueryCmdError IO ())
-> Value -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ CommitteeMembersState StandardCrypto -> Value
forall a. ToJSON a => a -> Value
A.toJSON CommitteeMembersState StandardCrypto
committeeState

runQueryTreasuryValue
  :: Cmd.QueryTreasuryValueCmdArgs era
  -> ExceptT QueryCmdError IO ()
runQueryTreasuryValue :: forall era.
QueryTreasuryValueCmdArgs era -> ExceptT QueryCmdError IO ()
runQueryTreasuryValue
  Cmd.QueryTreasuryValueCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. QueryTreasuryValueCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryTreasuryValueCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. QueryTreasuryValueCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    L.AccountState (L.Coin Integer
treasury) Lovelace
_reserves <-
      LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
-> ExceptT QueryCmdError IO AccountState
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError (Either EraMismatch AccountState))
 -> ExceptT QueryCmdError IO AccountState)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
-> ExceptT QueryCmdError IO AccountState
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
forall era block point r.
ConwayEraOnwards era
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError (Either EraMismatch AccountState))
queryAccountState ConwayEraOnwards era
eon
    let treasuryString :: String
treasuryString = Integer -> String
forall a. Show a => a -> String
show Integer
treasury
    case Maybe (File () 'Out)
mOutFile of
      Maybe (File () 'Out)
Nothing ->
        IO () -> ExceptT QueryCmdError IO ()
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT QueryCmdError IO ())
-> IO () -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
treasuryString
      Just File () 'Out
outFile ->
        (FileError () -> QueryCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> QueryCmdError
QueryCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT QueryCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
          File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
outFile (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
            String -> ByteString
LBS.pack String
treasuryString

runQueryProposals
  :: Cmd.QueryProposalsCmdArgs era
  -> ExceptT QueryCmdError IO ()
runQueryProposals :: forall era.
QueryProposalsCmdArgs era -> ExceptT QueryCmdError IO ()
runQueryProposals
  Cmd.QueryProposalsCmdArgs
    { ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. QueryProposalsCmdArgs era -> ConwayEraOnwards era
Cmd.eon
    , commons :: forall era. QueryProposalsCmdArgs era -> QueryCommons
Cmd.commons =
      Cmd.QueryCommons
        { SocketPath
nodeSocketPath :: QueryCommons -> SocketPath
nodeSocketPath :: SocketPath
Cmd.nodeSocketPath
        , ConsensusModeParams
consensusModeParams :: QueryCommons -> ConsensusModeParams
consensusModeParams :: ConsensusModeParams
Cmd.consensusModeParams
        , NetworkId
networkId :: QueryCommons -> NetworkId
networkId :: NetworkId
Cmd.networkId
        , Target ChainPoint
target :: QueryCommons -> Target ChainPoint
target :: Target ChainPoint
Cmd.target
        }
    , govActionIds :: forall era.
QueryProposalsCmdArgs era -> AllOrOnly (GovActionId StandardCrypto)
Cmd.govActionIds = AllOrOnly (GovActionId StandardCrypto)
govActionIds'
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. QueryProposalsCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    } = ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
 -> ExceptT QueryCmdError IO ())
-> (ConwayEraOnwardsConstraints era => ExceptT QueryCmdError IO ())
-> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

    let govActionIds :: [GovActionId StandardCrypto]
govActionIds = case AllOrOnly (GovActionId StandardCrypto)
govActionIds' of
          AllOrOnly (GovActionId StandardCrypto)
All -> []
          Only [GovActionId StandardCrypto]
l -> [GovActionId StandardCrypto]
l

    Seq (GovActionState (ShelleyLedgerEra era))
govActionStates :: (Seq.Seq (L.GovActionState (ShelleyLedgerEra era))) <-
      LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
-> ExceptT
     QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era)))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either UnsupportedNtcVersionError (Either EraMismatch a))
-> ExceptT QueryCmdError IO a
runQuery LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either
      UnsupportedNtcVersionError
      (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
 -> ExceptT
      QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era))))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
-> ExceptT
     QueryCmdError IO (Seq (GovActionState (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Set (GovActionId StandardCrypto)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
forall era block point r.
ConwayEraOnwards era
-> Set (GovActionId StandardCrypto)
-> LocalStateQueryExpr
     block
     point
     QueryInMode
     r
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
queryProposals ConwayEraOnwards era
eon (Set (GovActionId StandardCrypto)
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either
         UnsupportedNtcVersionError
         (Either
            EraMismatch (Seq (GovActionState (ShelleyLedgerEra era))))))
-> Set (GovActionId StandardCrypto)
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either
        UnsupportedNtcVersionError
        (Either EraMismatch (Seq (GovActionState (ShelleyLedgerEra era)))))
forall a b. (a -> b) -> a -> b
$ [GovActionId StandardCrypto] -> Set (GovActionId StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList [GovActionId StandardCrypto]
govActionIds

    Maybe (File () 'Out)
-> Seq (GovActionState (ShelleyLedgerEra era))
-> ExceptT QueryCmdError IO ()
forall b a.
ToJSON b =>
Maybe (File a 'Out) -> b -> ExceptT QueryCmdError IO ()
writeOutput Maybe (File () 'Out)
mOutFile Seq (GovActionState (ShelleyLedgerEra era))
govActionStates

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

writeOutput
  :: ToJSON b
  => Maybe (File a Out)
  -> b
  -> ExceptT QueryCmdError IO ()
writeOutput :: forall b a.
ToJSON b =>
Maybe (File a 'Out) -> b -> ExceptT QueryCmdError IO ()
writeOutput Maybe (File a 'Out)
mOutFile b
content = case Maybe (File a 'Out)
mOutFile of
  Maybe (File a 'Out)
Nothing -> IO () -> ExceptT QueryCmdError IO ()
forall a. IO a -> ExceptT QueryCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT QueryCmdError IO ())
-> (b -> IO ()) -> b -> ExceptT QueryCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> (b -> ByteString) -> b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (b -> ExceptT QueryCmdError IO ())
-> b -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ b
content
  Just (File String
f) ->
    (IOException -> QueryCmdError)
-> IO () -> ExceptT QueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> QueryCmdError
QueryCmdWriteFileError (FileError () -> QueryCmdError)
-> (IOException -> FileError ()) -> IOException -> QueryCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
f) (IO () -> ExceptT QueryCmdError IO ())
-> IO () -> ExceptT QueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      String -> ByteString -> IO ()
LBS.writeFile String
f (b -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty b
content)

-- Helpers

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

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

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

-- | Get slot number for timestamp, or an error if the UTC timestamp is before 'SystemStart' or after N+1 era
utcTimeToSlotNo
  :: SocketPath
  -> ConsensusModeParams
  -> NetworkId
  -> Consensus.Target ChainPoint
  -> UTCTime
  -> ExceptT QueryCmdError IO SlotNo
utcTimeToSlotNo :: SocketPath
-> ConsensusModeParams
-> NetworkId
-> Target ChainPoint
-> UTCTime
-> ExceptT QueryCmdError IO SlotNo
utcTimeToSlotNo SocketPath
nodeSocketPath ConsensusModeParams
consensusModeParams NetworkId
networkId Target ChainPoint
target UTCTime
utcTime = do
  let localNodeConnInfo :: LocalNodeConnectInfo
localNodeConnInfo = ConsensusModeParams
-> NetworkId -> SocketPath -> LocalNodeConnectInfo
LocalNodeConnectInfo ConsensusModeParams
consensusModeParams NetworkId
networkId SocketPath
nodeSocketPath

  IO (Either AcquiringFailure (Either QueryCmdError SlotNo))
-> ExceptT
     QueryCmdError
     IO
     (Either AcquiringFailure (Either QueryCmdError SlotNo))
forall (m :: * -> *) a. Monad m => m a -> ExceptT QueryCmdError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
    ( LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError SlotNo)
-> IO (Either AcquiringFailure (Either QueryCmdError SlotNo))
forall a.
LocalNodeConnectInfo
-> Target ChainPoint
-> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a
-> IO (Either AcquiringFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo
localNodeConnInfo Target ChainPoint
target (LocalStateQueryExpr
   BlockInMode
   ChainPoint
   QueryInMode
   ()
   IO
   (Either QueryCmdError SlotNo)
 -> IO (Either AcquiringFailure (Either QueryCmdError SlotNo)))
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError SlotNo)
-> IO (Either AcquiringFailure (Either QueryCmdError SlotNo))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  SlotNo
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError SlotNo)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QueryCmdError
   (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
   SlotNo
 -> LocalStateQueryExpr
      BlockInMode
      ChainPoint
      QueryInMode
      ()
      IO
      (Either QueryCmdError SlotNo))
-> ExceptT
     QueryCmdError
     (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
     SlotNo
-> LocalStateQueryExpr
     BlockInMode
     ChainPoint
     QueryInMode
     ()
     IO
     (Either QueryCmdError SlotNo)
forall a b. (a -> b) -> a -> b
$ do
        SystemStart
systemStart <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  SystemStart
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  SystemStart
easyRunQuerySystemStart
        EraHistory
eraHistory <- ExceptT
  QueryCmdError
  (LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO)
  EraHistory
forall block point r.
ExceptT
  QueryCmdError
  (LocalStateQueryExpr block point QueryInMode r IO)
  EraHistory
easyRunQueryEraHistory

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

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

requireEon
  :: forall eon era minEra m
   . (Eon eon, Monad m)
  => CardanoEra minEra
  -- ^ minimal required era i.e. for 'ConwayEraOnwards' eon it's 'Conway'
  -> CardanoEra era
  -- ^ node era
  -> ExceptT QueryCmdError m (eon era)
-- TODO: implement 'Bounded' for `Some eon` and remove 'minEra'
requireEon :: forall (eon :: * -> *) era minEra (m :: * -> *).
(Eon eon, Monad m) =>
CardanoEra minEra
-> CardanoEra era -> ExceptT QueryCmdError m (eon era)
requireEon CardanoEra minEra
minEra CardanoEra era
era =
  QueryCmdError
-> Maybe (eon era) -> ExceptT QueryCmdError m (eon era)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe
    (NodeEraMismatchError -> QueryCmdError
mkEraMismatchError NodeEraMismatchError{nodeEra :: CardanoEra era
nodeEra = CardanoEra era
era, era :: CardanoEra minEra
era = CardanoEra minEra
minEra})
    (CardanoEra era -> Maybe (eon era)
forall (eon :: * -> *) era.
Eon eon =>
CardanoEra era -> Maybe (eon era)
forEraMaybeEon CardanoEra era
era)

-- | The output format to use, for commands with a recently introduced --output-[json,text] flag
-- and that used to have the following default: --out-file implies JSON,
-- output to stdout implied text.
newOutputFormat :: Maybe OutputFormatJsonOrText -> Maybe a -> OutputFormatJsonOrText
newOutputFormat :: forall a.
Maybe OutputFormatJsonOrText -> Maybe a -> OutputFormatJsonOrText
newOutputFormat Maybe OutputFormatJsonOrText
format Maybe a
mOutFile =
  case (Maybe OutputFormatJsonOrText
format, Maybe a
mOutFile) of
    (Just OutputFormatJsonOrText
f, Maybe a
_) -> OutputFormatJsonOrText
f -- Take flag from CLI if specified
    (Maybe OutputFormatJsonOrText
Nothing, Maybe a
Nothing) -> OutputFormatJsonOrText
OutputFormatText -- No CLI flag, writing to stdout: write text
    (Maybe OutputFormatJsonOrText
Nothing, Just a
_) -> OutputFormatJsonOrText
OutputFormatJson -- No CLI flag, writing to a file: write JSON

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

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

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

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

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