{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Cardano.CLI.Shelley.Run.Query
  ( ShelleyQueryCmdError
  , ShelleyQueryCmdLocalStateQueryError (..)
  , renderShelleyQueryCmdError
  , renderLocalStateQueryError
  , runQueryCmd
  , percentage
  , executeQuery
  ) where

import           Cardano.Api
import           Cardano.Api.Byron
import           Cardano.Api.Shelley
import           Cardano.Binary (decodeFull)
import           Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import           Cardano.CLI.Helpers (HelpersError (..), hushM, pPrintCBOR, renderHelpersError)
import           Cardano.CLI.Shelley.Orphans ()
import           Cardano.CLI.Shelley.Parsers (OutputFile (..), QueryCmd (..))
import           Cardano.CLI.Types
import           Cardano.Crypto.Hash (hashToBytesAsHex)
import           Cardano.Ledger.Coin
import           Cardano.Ledger.Crypto (StandardCrypto)
import           Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import           Cardano.Prelude hiding (atomically)
import           Control.Concurrent.STM
import           Control.Monad.Trans.Except (except)
import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistMaybe, left)
import           Data.Aeson (ToJSON (..), (.=))
import           Data.Aeson.Encode.Pretty (encodePretty)
import           Data.List (nub)
import           Data.Time.Clock
import           Numeric (showEFloat)
import           Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime (..),
                   SystemStart (..), toRelativeTime)
import           Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..))
import           Ouroboros.Network.Block (Serialised (..))
import           Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..))
import           Prelude (String, id)
import           Shelley.Spec.Ledger.EpochBoundary
import           Shelley.Spec.Ledger.LedgerState hiding (_delegations)
import           Shelley.Spec.Ledger.Scripts ()
import           Text.Printf (printf)

import qualified Cardano.CLI.Shelley.Output as O
import qualified Cardano.Ledger.Crypto as Crypto
import qualified Cardano.Ledger.Era as Era
import qualified Cardano.Ledger.Shelley.Constraints as Ledger
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.IO as T
import qualified Data.Text.IO as Text
import qualified Data.Vector as Vector
import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry
import qualified Ouroboros.Network.Protocol.ChainSync.Client as Net.Sync
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
import qualified Shelley.Spec.Ledger.API.Protocol as Ledger
import qualified System.IO as IO

{- HLINT ignore "Reduce duplication" -}
{- HLINT ignore "Use let" -}

data ShelleyQueryCmdError
  = ShelleyQueryCmdEnvVarSocketErr !EnvSocketError
  | ShelleyQueryCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError
  | ShelleyQueryCmdWriteFileError !(FileError ())
  | ShelleyQueryCmdHelpersError !HelpersError
  | ShelleyQueryCmdAcquireFailure !AcquireFailure
  | ShelleyQueryCmdEraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra
  | ShelleyQueryCmdByronEra
  | ShelleyQueryCmdPoolIdError (Hash StakePoolKey)
  | ShelleyQueryCmdEraMismatch !EraMismatch
  | ShelleyQueryCmdUnsupportedMode !AnyConsensusMode
  | ShelleyQueryCmdPastHorizon !Qry.PastHorizonException
  | ShelleyQueryCmdSystemStartUnavailable
  deriving Int -> ShelleyQueryCmdError -> ShowS
[ShelleyQueryCmdError] -> ShowS
ShelleyQueryCmdError -> String
(Int -> ShelleyQueryCmdError -> ShowS)
-> (ShelleyQueryCmdError -> String)
-> ([ShelleyQueryCmdError] -> ShowS)
-> Show ShelleyQueryCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyQueryCmdError] -> ShowS
$cshowList :: [ShelleyQueryCmdError] -> ShowS
show :: ShelleyQueryCmdError -> String
$cshow :: ShelleyQueryCmdError -> String
showsPrec :: Int -> ShelleyQueryCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyQueryCmdError -> ShowS
Show

renderShelleyQueryCmdError :: ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError :: ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError ShelleyQueryCmdError
err =
  case ShelleyQueryCmdError
err of
    ShelleyQueryCmdEnvVarSocketErr EnvSocketError
envSockErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
envSockErr
    ShelleyQueryCmdLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
lsqErr -> ShelleyQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
lsqErr
    ShelleyQueryCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
    ShelleyQueryCmdHelpersError HelpersError
helpersErr -> HelpersError -> Text
renderHelpersError HelpersError
helpersErr
    ShelleyQueryCmdAcquireFailure AcquireFailure
acquireFail -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ AcquireFailure -> String
forall a b. (Show a, ConvertText String b) => a -> b
show AcquireFailure
acquireFail
    ShelleyQueryCmdError
ShelleyQueryCmdByronEra -> Text
"This query cannot be used for the Byron era"
    ShelleyQueryCmdPoolIdError Hash StakePoolKey
poolId -> Text
"The pool id does not exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash StakePoolKey -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Hash StakePoolKey
poolId
    ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode ConsensusMode mode
cMode) (AnyCardanoEra CardanoEra era
era) ->
      Text
"Consensus mode and era mismatch. Consensus mode: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConsensusMode mode -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ConsensusMode mode
cMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
" Era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CardanoEra era -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show CardanoEra era
era
    ShelleyQueryCmdEraMismatch (EraMismatch Text
ledgerEra Text
queryEra) ->
      Text
"\nAn error mismatch occured." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nSpecified query era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
queryEra Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"\nCurrent ledger era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ledgerEra
    ShelleyQueryCmdUnsupportedMode AnyConsensusMode
mode -> Text
"Unsupported mode: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyConsensusMode -> Text
renderMode AnyConsensusMode
mode
    ShelleyQueryCmdPastHorizon PastHorizonException
e -> Text
"Past horizon: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PastHorizonException -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show PastHorizonException
e
    ShelleyQueryCmdError
ShelleyQueryCmdSystemStartUnavailable -> Text
"System start unavailable"

runQueryCmd :: QueryCmd -> ExceptT ShelleyQueryCmdError IO ()
runQueryCmd :: QueryCmd -> ExceptT ShelleyQueryCmdError IO ()
runQueryCmd QueryCmd
cmd =
  case QueryCmd
cmd of
    QueryProtocolParameters' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
      AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
    QueryTip AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
      AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryTip AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
    QueryStakeDistribution' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
      AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
    QueryStakeAddressInfo AnyConsensusModeParams
consensusModeParams StakeAddress
addr NetworkId
network Maybe OutputFile
mOutFile ->
      AnyConsensusModeParams
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo AnyConsensusModeParams
consensusModeParams StakeAddress
addr NetworkId
network Maybe OutputFile
mOutFile
    QueryDebugLedgerState' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
      AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
    QueryStakeSnapshot' AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid ->
      AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeSnapshot AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid
    QueryPoolParams' AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid ->
      AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryPoolParams AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid
    QueryProtocolState' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
      AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolState AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
    QueryUTxO' AnyConsensusModeParams
consensusModeParams QueryUTxOFilter
qFilter NetworkId
networkId Maybe OutputFile
mOutFile ->
      AnyConsensusModeParams
-> QueryUTxOFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO AnyConsensusModeParams
consensusModeParams QueryUTxOFilter
qFilter NetworkId
networkId Maybe OutputFile
mOutFile

runQueryProtocolParameters
  :: AnyConsensusModeParams
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr
                           ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

  anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
  let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era

  case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
    Just EraInMode era mode
eInMode -> do
      let query :: QueryInMode mode (Either EraMismatch ProtocolParameters)
query = EraInMode era mode
-> QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
                    (QueryInEra era ProtocolParameters
 -> QueryInMode mode (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era ProtocolParameters
-> QueryInEra era ProtocolParameters
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe QueryInShelleyBasedEra era ProtocolParameters
forall era. QueryInShelleyBasedEra era ProtocolParameters
QueryProtocolParameters
      ProtocolParameters
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT ShelleyQueryCmdError IO ProtocolParameters
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
                  CardanoEra era
era
                  ConsensusModeParams mode
cModeParams
                  LocalNodeConnectInfo mode
localNodeConnInfo
                  QueryInMode mode (Either EraMismatch ProtocolParameters)
query
      Maybe OutputFile
-> ProtocolParameters -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolParameters Maybe OutputFile
mOutFile ProtocolParameters
result
    Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE
 where
  writeProtocolParameters
    :: Maybe OutputFile
    -> ProtocolParameters
    -> ExceptT ShelleyQueryCmdError IO ()
  writeProtocolParameters :: Maybe OutputFile
-> ProtocolParameters -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolParameters Maybe OutputFile
mOutFile' ProtocolParameters
pparams =
    case Maybe OutputFile
mOutFile' of
      Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (ProtocolParameters -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ProtocolParameters
pparams)
      Just (OutputFile String
fpath) ->
        (IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
          String -> ByteString -> IO ()
LBS.writeFile String
fpath (ProtocolParameters -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ProtocolParameters
pparams)

-- | Calculate the percentage sync rendered as text.
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
  -- ^ 'nowTime'.  The time of the most recently synced block.
  -> RelativeTime
  -- ^ 'tipTime'.  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 = Double -> Double
forall a. a -> a
id @Double (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ua Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral  Integer
ub) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100.0

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

runQueryTip
  :: AnyConsensusModeParams
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryTip :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryTip (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath

  case ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams of
    ConsensusMode mode
CardanoMode -> do
      let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

      (ChainTip
chainTip, Either AcquireFailure (Maybe QueryTipLocalState)
emLocalState) <- IO (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
-> ExceptT
     ShelleyQueryCmdError
     IO
     (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
 -> ExceptT
      ShelleyQueryCmdError
      IO
      (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState)))
-> IO (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
-> ExceptT
     ShelleyQueryCmdError
     IO
     (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo CardanoMode
-> Maybe ChainPoint
-> IO (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
queryQueryTip LocalNodeConnectInfo mode
LocalNodeConnectInfo CardanoMode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing

      Maybe QueryTipLocalState
mLocalState <- (Maybe (Maybe QueryTipLocalState) -> Maybe QueryTipLocalState)
-> ExceptT
     ShelleyQueryCmdError IO (Maybe (Maybe QueryTipLocalState))
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe QueryTipLocalState) -> Maybe QueryTipLocalState
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT ShelleyQueryCmdError IO (Maybe (Maybe QueryTipLocalState))
 -> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalState))
-> ((AcquireFailure -> ExceptT ShelleyQueryCmdError IO ())
    -> ExceptT
         ShelleyQueryCmdError IO (Maybe (Maybe QueryTipLocalState)))
-> (AcquireFailure -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalState)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either AcquireFailure (Maybe QueryTipLocalState)
-> (AcquireFailure -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT
     ShelleyQueryCmdError IO (Maybe (Maybe QueryTipLocalState))
forall e (m :: * -> *) a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM Either AcquireFailure (Maybe QueryTipLocalState)
emLocalState ((AcquireFailure -> ExceptT ShelleyQueryCmdError IO ())
 -> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalState))
-> (AcquireFailure -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalState)
forall a b. (a -> b) -> a -> b
$ \AcquireFailure
e -> do
        IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Handle -> Text -> IO ()
T.hPutStrLn Handle
IO.stderr (Text -> ExceptT ShelleyQueryCmdError IO ())
-> Text -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
          Text
"Warning: Local state unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError (AcquireFailure -> ShelleyQueryCmdError
ShelleyQueryCmdAcquireFailure AcquireFailure
e)

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

      Maybe QueryTipLocalStateOutput
mLocalStateOutput :: Maybe O.QueryTipLocalStateOutput <- (Maybe (Maybe QueryTipLocalStateOutput)
 -> Maybe QueryTipLocalStateOutput)
-> ExceptT
     ShelleyQueryCmdError IO (Maybe (Maybe QueryTipLocalStateOutput))
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe QueryTipLocalStateOutput)
-> Maybe QueryTipLocalStateOutput
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT
   ShelleyQueryCmdError IO (Maybe (Maybe QueryTipLocalStateOutput))
 -> ExceptT
      ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ((QueryTipLocalState
     -> ExceptT
          ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
    -> ExceptT
         ShelleyQueryCmdError IO (Maybe (Maybe QueryTipLocalStateOutput)))
-> (QueryTipLocalState
    -> ExceptT
         ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe QueryTipLocalState
-> (QueryTipLocalState
    -> ExceptT
         ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ExceptT
     ShelleyQueryCmdError IO (Maybe (Maybe QueryTipLocalStateOutput))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe QueryTipLocalState
mLocalState ((QueryTipLocalState
  -> ExceptT
       ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
 -> ExceptT
      ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> (QueryTipLocalState
    -> ExceptT
         ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall a b. (a -> b) -> a -> b
$ \QueryTipLocalState
localState -> do
        case SlotNo
-> EraHistory CardanoMode
-> Either
     PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
forall mode.
SlotNo
-> EraHistory mode
-> Either
     PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
slotToEpoch SlotNo
tipSlotNo (QueryTipLocalState -> EraHistory CardanoMode
O.eraHistory QueryTipLocalState
localState) of
          Left PastHorizonException
e -> do
            IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Handle -> Text -> IO ()
T.hPutStrLn Handle
IO.stderr (Text -> ExceptT ShelleyQueryCmdError IO ())
-> Text -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
              Text
"Warning: Epoch unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError (PastHorizonException -> ShelleyQueryCmdError
ShelleyQueryCmdPastHorizon PastHorizonException
e)
            Maybe QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe QueryTipLocalStateOutput
forall a. Maybe a
Nothing
          Right (EpochNo
epochNo, SlotsInEpoch
_, SlotsToEpochEnd
_) -> do
            Either ShelleyQueryCmdError Text
syncProgressResult <- ExceptT ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
-> ExceptT
     ShelleyQueryCmdError IO (Either ShelleyQueryCmdError Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
 -> ExceptT
      ShelleyQueryCmdError IO (Either ShelleyQueryCmdError Text))
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
-> ExceptT
     ShelleyQueryCmdError IO (Either ShelleyQueryCmdError Text)
forall a b. (a -> b) -> a -> b
$ do
              UTCTime
systemStart <- (SystemStart -> UTCTime) -> Maybe SystemStart -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SystemStart -> UTCTime
getSystemStart (QueryTipLocalState -> Maybe SystemStart
O.mSystemStart QueryTipLocalState
localState) Maybe UTCTime
-> (Maybe UTCTime
    -> ExceptT
         ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime)
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe UTCTime
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe ShelleyQueryCmdError
ShelleyQueryCmdSystemStartUnavailable
              RelativeTime
nowSeconds <- SystemStart -> UTCTime -> RelativeTime
toRelativeTime (UTCTime -> SystemStart
SystemStart UTCTime
systemStart) (UTCTime -> RelativeTime)
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
              RelativeTime
tipTimeResult <- SlotNo
-> EraHistory CardanoMode
-> Either PastHorizonException (RelativeTime, SlotLength)
forall mode.
SlotNo
-> EraHistory mode
-> Either PastHorizonException (RelativeTime, SlotLength)
getProgress SlotNo
tipSlotNo (QueryTipLocalState -> EraHistory CardanoMode
O.eraHistory QueryTipLocalState
localState) Either PastHorizonException (RelativeTime, SlotLength)
-> (Either PastHorizonException (RelativeTime, SlotLength)
    -> Either ShelleyQueryCmdError RelativeTime)
-> Either ShelleyQueryCmdError RelativeTime
forall a b. a -> (a -> b) -> b
& (PastHorizonException -> ShelleyQueryCmdError)
-> ((RelativeTime, SlotLength) -> RelativeTime)
-> Either PastHorizonException (RelativeTime, SlotLength)
-> Either ShelleyQueryCmdError RelativeTime
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap PastHorizonException -> ShelleyQueryCmdError
ShelleyQueryCmdPastHorizon (RelativeTime, SlotLength) -> RelativeTime
forall a b. (a, b) -> a
fst Either ShelleyQueryCmdError RelativeTime
-> (Either ShelleyQueryCmdError RelativeTime
    -> ExceptT
         ShelleyQueryCmdError
         (ExceptT ShelleyQueryCmdError IO)
         RelativeTime)
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) RelativeTime
forall a b. a -> (a -> b) -> b
& Either ShelleyQueryCmdError RelativeTime
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) RelativeTime
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except

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

              Text
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
 -> ExceptT
      ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text)
-> Text
-> ExceptT
     ShelleyQueryCmdError (ExceptT ShelleyQueryCmdError IO) Text
forall a b. (a -> b) -> a -> b
$ (RelativeTime -> RelativeTime -> Text)
-> RelativeTime -> RelativeTime -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RelativeTime -> RelativeTime -> RelativeTime -> Text
percentage RelativeTime
tolerance) RelativeTime
nowSeconds RelativeTime
tipTimeResult

            Maybe Text
mSyncProgress <- Either ShelleyQueryCmdError Text
-> (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe Text)
forall e (m :: * -> *) a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM Either ShelleyQueryCmdError Text
syncProgressResult ((ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
 -> ExceptT ShelleyQueryCmdError IO (Maybe Text))
-> (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT ShelleyQueryCmdError IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ShelleyQueryCmdError
e -> do
              IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Handle -> Text -> IO ()
T.hPutStrLn Handle
IO.stderr (Text -> ExceptT ShelleyQueryCmdError IO ())
-> Text -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Warning: Sync progress unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError ShelleyQueryCmdError
e

            Maybe QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe QueryTipLocalStateOutput
 -> ExceptT
      ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> Maybe QueryTipLocalStateOutput
-> ExceptT ShelleyQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall a b. (a -> b) -> a -> b
$ QueryTipLocalStateOutput -> Maybe QueryTipLocalStateOutput
forall a. a -> Maybe a
Just (QueryTipLocalStateOutput -> Maybe QueryTipLocalStateOutput)
-> QueryTipLocalStateOutput -> Maybe QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$ QueryTipLocalStateOutput :: Maybe AnyCardanoEra
-> Maybe EpochNo -> Maybe Text -> QueryTipLocalStateOutput
O.QueryTipLocalStateOutput
              { $sel:mEra:QueryTipLocalStateOutput :: Maybe AnyCardanoEra
O.mEra = AnyCardanoEra -> Maybe AnyCardanoEra
forall a. a -> Maybe a
Just (QueryTipLocalState -> AnyCardanoEra
O.era QueryTipLocalState
localState)
              , $sel:mEpoch:QueryTipLocalStateOutput :: Maybe EpochNo
O.mEpoch = EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
epochNo
              , $sel:mSyncProgress:QueryTipLocalStateOutput :: Maybe Text
O.mSyncProgress = Maybe Text
mSyncProgress
              }

      let jsonOutput :: ByteString
jsonOutput = QueryTipOutput QueryTipLocalStateOutput -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (QueryTipOutput QueryTipLocalStateOutput -> ByteString)
-> QueryTipOutput QueryTipLocalStateOutput -> ByteString
forall a b. (a -> b) -> a -> b
$ QueryTipOutput :: forall localState.
ChainTip -> Maybe localState -> QueryTipOutput localState
O.QueryTipOutput
            { $sel:chainTip:QueryTipOutput :: ChainTip
O.chainTip = ChainTip
chainTip
            , $sel:mLocalState:QueryTipOutput :: Maybe QueryTipLocalStateOutput
O.mLocalState = Maybe QueryTipLocalStateOutput
mLocalStateOutput
            }

      case Maybe OutputFile
mOutFile of
        Just (OutputFile String
fpath) -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath ByteString
jsonOutput
        Maybe OutputFile
Nothing                 -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn        ByteString
jsonOutput

    ConsensusMode mode
mode -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (AnyConsensusMode -> ShelleyQueryCmdError
ShelleyQueryCmdUnsupportedMode (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode))

queryQueryTip
  :: LocalNodeConnectInfo CardanoMode
  -> Maybe ChainPoint
  -> IO (ChainTip, Either AcquireFailure (Maybe O.QueryTipLocalState))
queryQueryTip :: LocalNodeConnectInfo CardanoMode
-> Maybe ChainPoint
-> IO (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
queryQueryTip LocalNodeConnectInfo CardanoMode
connectInfo Maybe ChainPoint
mpoint = do
  TMVar (Maybe (Either AcquireFailure QueryTipLocalState))
resultVarQueryTipLocalState <- IO (TMVar (Maybe (Either AcquireFailure QueryTipLocalState)))
forall a. IO (TMVar a)
newEmptyTMVarIO
  TMVar ChainTip
resultVarChainTip <- IO (TMVar ChainTip)
forall a. IO (TMVar a)
newEmptyTMVarIO

  STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
waitResult <- STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
-> IO
     (STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
 -> IO
      (STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))))
-> STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
-> IO
     (STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState)))
forall a b. (a -> b) -> a -> b
$ (,)
    (ChainTip
 -> Either AcquireFailure (Maybe QueryTipLocalState)
 -> (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState)))
-> STM ChainTip
-> STM
     (Either AcquireFailure (Maybe QueryTipLocalState)
      -> (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMVar ChainTip -> STM ChainTip
forall a. TMVar a -> STM a
readTMVar TMVar ChainTip
resultVarChainTip
    STM
  (Either AcquireFailure (Maybe QueryTipLocalState)
   -> (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState)))
-> STM (Either AcquireFailure (Maybe QueryTipLocalState))
-> STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe (Either AcquireFailure QueryTipLocalState)
-> Either AcquireFailure (Maybe QueryTipLocalState)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe (Either AcquireFailure QueryTipLocalState)
 -> Either AcquireFailure (Maybe QueryTipLocalState))
-> STM (Maybe (Either AcquireFailure QueryTipLocalState))
-> STM (Either AcquireFailure (Maybe QueryTipLocalState))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMVar (Maybe (Either AcquireFailure QueryTipLocalState))
-> STM (Maybe (Either AcquireFailure QueryTipLocalState))
forall a. TMVar a -> STM a
readTMVar TMVar (Maybe (Either AcquireFailure QueryTipLocalState))
resultVarQueryTipLocalState)

  LocalNodeConnectInfo CardanoMode
-> (NodeToClientVersion
    -> LocalNodeClientProtocolsInMode CardanoMode)
-> IO ()
forall mode.
LocalNodeConnectInfo mode
-> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
-> IO ()
connectToLocalNodeWithVersion
    LocalNodeConnectInfo CardanoMode
connectInfo
    (\NodeToClientVersion
ntcVersion ->
      LocalNodeClientProtocols :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalChainSyncClient block point tip m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
-> Maybe (LocalStateQueryClient block point query m ())
-> LocalNodeClientProtocols block point tip tx txerr query m
LocalNodeClientProtocols
      { localChainSyncClient :: LocalChainSyncClient
  (BlockInMode CardanoMode) ChainPoint ChainTip IO
localChainSyncClient    = ChainSyncClient (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> LocalChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO
forall block point tip (m :: * -> *).
ChainSyncClient block point tip m ()
-> LocalChainSyncClient block point tip m
LocalChainSyncClient (ChainSyncClient
   (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
 -> LocalChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO)
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> LocalChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO
forall a b. (a -> b) -> a -> b
$ STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
-> TMVar ChainTip
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall mode a.
STM a
-> TMVar ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
chainSyncGetCurrentTip STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
waitResult TMVar ChainTip
resultVarChainTip
      , localStateQueryClient :: Maybe
  (LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
localStateQueryClient   = LocalStateQueryClient
  (BlockInMode CardanoMode)
  ChainPoint
  (QueryInMode CardanoMode)
  IO
  ()
-> Maybe
     (LocalStateQueryClient
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a. a -> Maybe a
Just (LocalStateQueryClient
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   IO
   ()
 -> Maybe
      (LocalStateQueryClient
         (BlockInMode CardanoMode)
         ChainPoint
         (QueryInMode CardanoMode)
         IO
         ()))
-> LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
-> Maybe
     (LocalStateQueryClient
        (BlockInMode CardanoMode)
        ChainPoint
        (QueryInMode CardanoMode)
        IO
        ())
forall a b. (a -> b) -> a -> b
$ STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
-> Maybe ChainPoint
-> NodeToClientVersion
-> TMVar (Maybe (Either AcquireFailure QueryTipLocalState))
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     QueryTipLocalState
-> LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall x a.
STM x
-> Maybe ChainPoint
-> NodeToClientVersion
-> TMVar (Maybe (Either AcquireFailure a))
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     a
-> LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
setupLocalStateQueryScript STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
waitResult Maybe ChainPoint
mpoint NodeToClientVersion
ntcVersion TMVar (Maybe (Either AcquireFailure QueryTipLocalState))
resultVarQueryTipLocalState (LocalStateQueryScript
   (BlockInMode CardanoMode)
   ChainPoint
   (QueryInMode CardanoMode)
   ()
   IO
   QueryTipLocalState
 -> LocalStateQueryClient
      (BlockInMode CardanoMode)
      ChainPoint
      (QueryInMode CardanoMode)
      IO
      ())
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     QueryTipLocalState
-> LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ()
forall a b. (a -> b) -> a -> b
$ do
          AnyCardanoEra
era <- QueryInMode CardanoMode AnyCardanoEra
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     AnyCardanoEra
forall (m :: * -> *) (query :: * -> *) a block point r.
Monad m =>
query a -> LocalStateQueryScript block point query r m a
sendMsgQuery (ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode AnyCardanoEra
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode AnyCardanoEra
QueryCurrentEra ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra)
          EraHistory CardanoMode
eraHistory <- QueryInMode CardanoMode (EraHistory CardanoMode)
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     (EraHistory CardanoMode)
forall (m :: * -> *) (query :: * -> *) a block point r.
Monad m =>
query a -> LocalStateQueryScript block point query r m a
sendMsgQuery (ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode (EraHistory CardanoMode)
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
QueryEraHistory ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra)
          Maybe SystemStart
mSystemStart <- if NodeToClientVersion
ntcVersion NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_9
            then SystemStart -> Maybe SystemStart
forall a. a -> Maybe a
Just (SystemStart -> Maybe SystemStart)
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     SystemStart
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     (Maybe SystemStart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryInMode CardanoMode SystemStart
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     SystemStart
forall (m :: * -> *) (query :: * -> *) a block point r.
Monad m =>
query a -> LocalStateQueryScript block point query r m a
sendMsgQuery QueryInMode CardanoMode SystemStart
forall mode. QueryInMode mode SystemStart
QuerySystemStart
            else Maybe SystemStart
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     (Maybe SystemStart)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SystemStart
forall a. Maybe a
Nothing
          QueryTipLocalState
-> LocalStateQueryScript
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     ()
     IO
     QueryTipLocalState
forall (m :: * -> *) a. Monad m => a -> m a
return QueryTipLocalState :: AnyCardanoEra
-> EraHistory CardanoMode
-> Maybe SystemStart
-> QueryTipLocalState
O.QueryTipLocalState
            { $sel:era:QueryTipLocalState :: AnyCardanoEra
O.era = AnyCardanoEra
era
            , $sel:eraHistory:QueryTipLocalState :: EraHistory CardanoMode
O.eraHistory = EraHistory CardanoMode
eraHistory
            , $sel:mSystemStart:QueryTipLocalState :: Maybe SystemStart
O.mSystemStart = Maybe SystemStart
mSystemStart
            }

      , localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) IO ())
localTxSubmissionClient = Maybe
  (LocalTxSubmissionClient
     (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) IO ())
forall a. Maybe a
Nothing
      }
    )

  STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
-> IO (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
forall a. STM a -> IO a
atomically STM (ChainTip, Either AcquireFailure (Maybe QueryTipLocalState))
waitResult

  where
    chainSyncGetCurrentTip
      :: forall mode a
      .  STM a
      -> TMVar  ChainTip
      -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
    chainSyncGetCurrentTip :: STM a
-> TMVar ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
chainSyncGetCurrentTip STM a
waitDone TMVar ChainTip
tipVar =
      IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
 -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ())
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
clientStIdle
      where
        clientStIdle :: Net.Sync.ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
        clientStIdle :: ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
clientStIdle =
          ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ())
-> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> m (ClientStNext header point tip m a)
-> ClientStIdle header point tip m a
Net.Sync.SendMsgRequestNext ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
clientStNext (ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
clientStNext)

        clientStNext :: Net.Sync.ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
        clientStNext :: ClientStNext (BlockInMode mode) ChainPoint ChainTip IO ()
clientStNext = ClientStNext :: forall header point tip (m :: * -> *) a.
(header -> tip -> ChainSyncClient header point tip m a)
-> (point -> tip -> ChainSyncClient header point tip m a)
-> ClientStNext header point tip m a
Net.Sync.ClientStNext
          { recvMsgRollForward :: BlockInMode mode
-> ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
Net.Sync.recvMsgRollForward = \BlockInMode mode
_block ChainTip
tip -> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
 -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ())
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ do
              IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> (STM () -> IO ()) -> STM () -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar ChainTip -> ChainTip -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ChainTip
tipVar ChainTip
tip
              IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ STM a -> IO a
forall a. STM a -> IO a
atomically STM a
waitDone
              ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
 -> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()))
-> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall a b. (a -> b) -> a -> b
$ () -> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
forall a header point tip (m :: * -> *).
a -> ClientStIdle header point tip m a
Net.Sync.SendMsgDone ()
          , recvMsgRollBackward :: ChainPoint
-> ChainTip
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
Net.Sync.recvMsgRollBackward = \ChainPoint
_point ChainTip
tip -> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
 -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ())
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
-> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ do
              IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> (STM () -> IO ()) -> STM () -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar ChainTip -> ChainTip -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ChainTip
tipVar ChainTip
tip
              IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ STM a -> IO a
forall a. STM a -> IO a
atomically STM a
waitDone
              ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
 -> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()))
-> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
-> IO (ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ())
forall a b. (a -> b) -> a -> b
$ () -> ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO ()
forall a header point tip (m :: * -> *).
a -> ClientStIdle header point tip m a
Net.Sync.SendMsgDone ()
          }

-- | Query the UTxO, filtered by a given set of addresses, from a Shelley node
-- via the local state query protocol.
--

runQueryUTxO
  :: AnyConsensusModeParams
  -> QueryUTxOFilter
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO :: AnyConsensusModeParams
-> QueryUTxOFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
             QueryUTxOFilter
qfilter NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

  anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
  let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era

  case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
    Just EraInMode era mode
eInMode -> do
      let query :: QueryInEra era (UTxO era)
query   = ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO QueryUTxOFilter
qfilter)
          qInMode :: QueryInMode mode (Either EraMismatch (UTxO era))
qInMode = EraInMode era mode
-> QueryInEra era (UTxO era)
-> QueryInMode mode (Either EraMismatch (UTxO era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode QueryInEra era (UTxO era)
query
      UTxO era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (UTxO era))
-> ExceptT ShelleyQueryCmdError IO (UTxO era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
                  CardanoEra era
era
                  ConsensusModeParams mode
cModeParams
                  LocalNodeConnectInfo mode
localNodeConnInfo
                  QueryInMode mode (Either EraMismatch (UTxO era))
qInMode
      ShelleyBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT ShelleyQueryCmdError IO ()
forall era.
ShelleyBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT ShelleyQueryCmdError IO ()
writeFilteredUTxOs ShelleyBasedEra era
sbe Maybe OutputFile
mOutFile UTxO era
result
    Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE


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

runQueryPoolParams
  :: AnyConsensusModeParams
  -> NetworkId
  -> Hash StakePoolKey
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryPoolParams :: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryPoolParams (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Hash StakePoolKey
poolid = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

  anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
  let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era

  EraInMode era mode
eInMode <- CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode
    Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
    -> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE)

  let qInMode :: QueryInMode
  mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode = EraInMode era mode
-> QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (SerialisedDebugLedgerState era)
 -> QueryInMode
      mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
    -> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
 -> QueryInMode
      mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
  SerialisedDebugLedgerState era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT ShelleyQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode
  mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
  ShelleyBasedEra era
-> ((ShelleyBased (ShelleyLedgerEra era),
     ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
     Crypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
    SerialisedDebugLedgerState era
    -> ExceptT ShelleyQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
     FromCBOR (DebugLedgerState era),
     Crypto ledgerera ~ StandardCrypto) =>
    a)
-> a
obtainLedgerEraClassConstraints ShelleyBasedEra era
sbe (Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera, FromCBOR (DebugLedgerState era),
 Crypto (Crypto ledgerera), Crypto ledgerera ~ StandardCrypto) =>
Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writePoolParams Hash StakePoolKey
poolid) SerialisedDebugLedgerState era
result


-- | 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.
runQueryStakeSnapshot
  :: AnyConsensusModeParams
  -> NetworkId
  -> Hash StakePoolKey
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeSnapshot :: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeSnapshot (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Hash StakePoolKey
poolid = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

  anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
  let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era

  EraInMode era mode
eInMode <- CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode
    Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
    -> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. a -> (a -> b) -> b
& ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE)

  let qInMode :: QueryInMode
  mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode = EraInMode era mode
-> QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (SerialisedDebugLedgerState era)
 -> QueryInMode
      mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
    -> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
 -> QueryInMode
      mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
  SerialisedDebugLedgerState era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT ShelleyQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode
  mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
  ShelleyBasedEra era
-> ((ShelleyBased (ShelleyLedgerEra era),
     ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
     Crypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
    SerialisedDebugLedgerState era
    -> ExceptT ShelleyQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
     FromCBOR (DebugLedgerState era),
     Crypto ledgerera ~ StandardCrypto) =>
    a)
-> a
obtainLedgerEraClassConstraints ShelleyBasedEra era
sbe (Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto,
 FromCBOR (DebugLedgerState era)) =>
Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeSnapshot Hash StakePoolKey
poolid) SerialisedDebugLedgerState era
result


runQueryLedgerState
  :: AnyConsensusModeParams
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
                    NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

  anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
  let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era

  case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
    Just EraInMode era mode
eInMode -> do
      let qInMode :: QueryInMode
  mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode = EraInMode era mode
-> QueryInEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
                      (QueryInEra era (SerialisedDebugLedgerState era)
 -> QueryInMode
      mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
    -> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
                      (QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
 -> QueryInMode
      mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInShelleyBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
      SerialisedDebugLedgerState era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
     mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT ShelleyQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
                  CardanoEra era
era
                  ConsensusModeParams mode
cModeParams
                  LocalNodeConnectInfo mode
localNodeConnInfo
                  QueryInMode
  mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
      ShelleyBasedEra era
-> ((ShelleyBased (ShelleyLedgerEra era),
     ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
     Crypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
    SerialisedDebugLedgerState era
    -> ExceptT ShelleyQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> ((ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
     FromCBOR (DebugLedgerState era),
     Crypto ledgerera ~ StandardCrypto) =>
    a)
-> a
obtainLedgerEraClassConstraints ShelleyBasedEra era
sbe (Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era)) =>
Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeLedgerState Maybe OutputFile
mOutFile) SerialisedDebugLedgerState era
result
    Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE


runQueryProtocolState
  :: AnyConsensusModeParams
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolState :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolState (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
                      NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

  anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
  let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era

  case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
    Just EraInMode era mode
eInMode -> do
      let qInMode :: QueryInMode mode (Either EraMismatch (ProtocolState era))
qInMode = EraInMode era mode
-> QueryInEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
                      (QueryInEra era (ProtocolState era)
 -> QueryInMode mode (Either EraMismatch (ProtocolState era)))
-> (QueryInShelleyBasedEra era (ProtocolState era)
    -> QueryInEra era (ProtocolState era))
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
                      (QueryInShelleyBasedEra era (ProtocolState era)
 -> QueryInMode mode (Either EraMismatch (ProtocolState era)))
-> QueryInShelleyBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (ProtocolState era)
forall era. QueryInShelleyBasedEra era (ProtocolState era)
QueryProtocolState
      ProtocolState era
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
-> ExceptT ShelleyQueryCmdError IO (ProtocolState era)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
                  CardanoEra era
era
                  ConsensusModeParams mode
cModeParams
                  LocalNodeConnectInfo mode
localNodeConnInfo
                  QueryInMode mode (Either EraMismatch (ProtocolState era))
qInMode
      Maybe OutputFile
-> ProtocolState era -> ExceptT ShelleyQueryCmdError IO ()
forall era.
Crypto StandardCrypto =>
Maybe OutputFile
-> ProtocolState era -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolState Maybe OutputFile
mOutFile ProtocolState era
result
    Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE

-- | Query the current delegations and reward accounts, filtered by a given
-- set of addresses, from a Shelley node via the local state query protocol.

runQueryStakeAddressInfo
  :: AnyConsensusModeParams
  -> StakeAddress
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo :: AnyConsensusModeParams
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
                         (StakeAddress Network
_ StakeCredential StandardCrypto
addr) NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

  anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
  let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era

  case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
    Just EraInMode era mode
eInMode -> do
      let stakeAddr :: Set StakeCredential
stakeAddr = StakeCredential -> Set StakeCredential
forall a. a -> Set a
Set.singleton (StakeCredential -> Set StakeCredential)
-> StakeCredential -> Set StakeCredential
forall a b. (a -> b) -> a -> b
$ StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential StakeCredential StandardCrypto
addr
          query :: QueryInMode
  mode
  (Either
     EraMismatch
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
query = EraInMode era mode
-> QueryInEra
     era
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
     mode
     (Either
        EraMismatch
        (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
                    (QueryInEra
   era
   (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
 -> QueryInMode
      mode
      (Either
         EraMismatch
         (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))))
-> (QueryInShelleyBasedEra
      era
      (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
    -> QueryInEra
         era
         (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
-> QueryInShelleyBasedEra
     era
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
     mode
     (Either
        EraMismatch
        (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra
     era
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInEra
     era
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
                    (QueryInShelleyBasedEra
   era
   (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
 -> QueryInMode
      mode
      (Either
         EraMismatch
         (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))))
-> QueryInShelleyBasedEra
     era
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
     mode
     (Either
        EraMismatch
        (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
forall a b. (a -> b) -> a -> b
$ Set StakeCredential
-> NetworkId
-> QueryInShelleyBasedEra
     era
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
forall era.
Set StakeCredential
-> NetworkId
-> QueryInShelleyBasedEra
     era
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
QueryStakeAddresses Set StakeCredential
stakeAddr NetworkId
network

      (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
     mode
     (Either
        EraMismatch
        (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
-> ExceptT
     ShelleyQueryCmdError
     IO
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
                  CardanoEra era
era
                  ConsensusModeParams mode
cModeParams
                  LocalNodeConnectInfo mode
localNodeConnInfo
                  QueryInMode
  mode
  (Either
     EraMismatch
     (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey)))
query
      Maybe OutputFile
-> DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo Maybe OutputFile
mOutFile (DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ())
-> DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
-> DelegationsAndRewards
DelegationsAndRewards (Map StakeAddress Lovelace, Map StakeAddress (Hash StakePoolKey))
result
    Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE

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

-- | An error that can occur while querying a node's local state.
data ShelleyQueryCmdLocalStateQueryError
  = AcquireFailureError !LocalStateQuery.AcquireFailure
  | EraMismatchError !EraMismatch
  -- ^ A query from a certain era was applied to a ledger from a different
  -- era.
  | ByronProtocolNotSupportedError
  -- ^ The query does not support the Byron protocol.
  | ShelleyProtocolEraMismatch
  -- ^ The Shelley protocol only supports the Shelley era.
  deriving (ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
(ShelleyQueryCmdLocalStateQueryError
 -> ShelleyQueryCmdLocalStateQueryError -> Bool)
-> (ShelleyQueryCmdLocalStateQueryError
    -> ShelleyQueryCmdLocalStateQueryError -> Bool)
-> Eq ShelleyQueryCmdLocalStateQueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
$c/= :: ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
== :: ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
$c== :: ShelleyQueryCmdLocalStateQueryError
-> ShelleyQueryCmdLocalStateQueryError -> Bool
Eq, Int -> ShelleyQueryCmdLocalStateQueryError -> ShowS
[ShelleyQueryCmdLocalStateQueryError] -> ShowS
ShelleyQueryCmdLocalStateQueryError -> String
(Int -> ShelleyQueryCmdLocalStateQueryError -> ShowS)
-> (ShelleyQueryCmdLocalStateQueryError -> String)
-> ([ShelleyQueryCmdLocalStateQueryError] -> ShowS)
-> Show ShelleyQueryCmdLocalStateQueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyQueryCmdLocalStateQueryError] -> ShowS
$cshowList :: [ShelleyQueryCmdLocalStateQueryError] -> ShowS
show :: ShelleyQueryCmdLocalStateQueryError -> String
$cshow :: ShelleyQueryCmdLocalStateQueryError -> String
showsPrec :: Int -> ShelleyQueryCmdLocalStateQueryError -> ShowS
$cshowsPrec :: Int -> ShelleyQueryCmdLocalStateQueryError -> ShowS
Show)

renderLocalStateQueryError :: ShelleyQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError :: ShelleyQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
lsqErr =
  case ShelleyQueryCmdLocalStateQueryError
lsqErr of
    AcquireFailureError AcquireFailure
err -> Text
"Local state query acquire failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AcquireFailure -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show AcquireFailure
err
    EraMismatchError EraMismatch
err ->
      Text
"A query from a certain era was applied to a ledger from a different era: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EraMismatch -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show EraMismatch
err
    ShelleyQueryCmdLocalStateQueryError
ByronProtocolNotSupportedError ->
      Text
"The attempted local state query does not support the Byron protocol."
    ShelleyQueryCmdLocalStateQueryError
ShelleyProtocolEraMismatch ->
        Text
"The Shelley protocol mode can only be used with the Shelley era, "
     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"i.e. with --shelley-mode use --shelley-era flag"

writeStakeAddressInfo
  :: Maybe OutputFile
  -> DelegationsAndRewards
  -> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo :: Maybe OutputFile
-> DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo Maybe OutputFile
mOutFile DelegationsAndRewards
delegsAndRewards =
  case Maybe OutputFile
mOutFile of
    Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (DelegationsAndRewards -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty DelegationsAndRewards
delegsAndRewards)
    Just (OutputFile String
fpath) ->
      (IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
        (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (DelegationsAndRewards -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty DelegationsAndRewards
delegsAndRewards)

writeLedgerState :: forall era ledgerera.
                    ShelleyLedgerEra era ~ ledgerera
                 => ToJSON (DebugLedgerState era)
                 => FromCBOR (DebugLedgerState era)
                 => Maybe OutputFile
                 -> SerialisedDebugLedgerState era
                 -> ExceptT ShelleyQueryCmdError IO ()
writeLedgerState :: Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeLedgerState Maybe OutputFile
mOutFile qState :: SerialisedDebugLedgerState era
qState@(SerialisedDebugLedgerState Serialised (NewEpochState (ShelleyLedgerEra era))
serLedgerState) =
  case Maybe OutputFile
mOutFile of
    Maybe OutputFile
Nothing -> case SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
decodeLedgerState SerialisedDebugLedgerState era
qState of
                 Left ByteString
bs -> (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
                 Right DebugLedgerState era
ledgerState -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ DebugLedgerState era -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty DebugLedgerState era
ledgerState
    Just (OutputFile String
fpath) ->
      (IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
        (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Serialised (NewEpochState ledgerera) -> ByteString
forall a. Serialised a -> ByteString
unSerialised Serialised (NewEpochState ledgerera)
Serialised (NewEpochState (ShelleyLedgerEra era))
serLedgerState

writeStakeSnapshot :: forall era ledgerera. ()
  => ShelleyLedgerEra era ~ ledgerera
  => Era.Crypto ledgerera ~ StandardCrypto
  => FromCBOR (DebugLedgerState era)
  => PoolId
  -> SerialisedDebugLedgerState era
  -> ExceptT ShelleyQueryCmdError IO ()
writeStakeSnapshot :: Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeSnapshot (StakePoolKeyHash hk) SerialisedDebugLedgerState era
qState =
  case SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
decodeLedgerState SerialisedDebugLedgerState era
qState of
    -- In the event of decode failure print the CBOR instead
    Left ByteString
bs -> (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs

    Right DebugLedgerState era
ledgerState -> do
      -- Ledger State
      let (DebugLedgerState NewEpochState ledgerera
snapshot) = DebugLedgerState era
ledgerState

      -- The three stake snapshots, obtained from the ledger state
      let (SnapShots SnapShot StandardCrypto
markS SnapShot StandardCrypto
setS SnapShot StandardCrypto
goS Coin
_) = EpochState ledgerera -> SnapShots (Crypto ledgerera)
forall era. EpochState era -> SnapShots (Crypto era)
esSnapshots (EpochState ledgerera -> SnapShots (Crypto ledgerera))
-> EpochState ledgerera -> SnapShots (Crypto ledgerera)
forall a b. (a -> b) -> a -> b
$ NewEpochState ledgerera -> EpochState ledgerera
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState ledgerera
snapshot

      -- Calculate the three pool and active stake values for the given pool
      IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Stakes -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Stakes -> ByteString) -> Stakes -> ByteString
forall a b. (a -> b) -> a -> b
$ Stakes :: Integer
-> Integer -> Integer -> Integer -> Integer -> Integer -> Stakes
Stakes
        { markPool :: Integer
markPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
markS
        , setPool :: Integer
setPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
setS
        , goPool :: Integer
goPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
goS
        , markTotal :: Integer
markTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
markS
        , setTotal :: Integer
setTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
setS
        , goTotal :: Integer
goTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
goS
        }

-- | Sum all the stake that is held by the pool
getPoolStake :: KeyHash Cardano.Ledger.Keys.StakePool crypto -> SnapShot crypto -> Integer
getPoolStake :: KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool crypto
hash SnapShot crypto
ss = Integer
pStake
  where
    Coin Integer
pStake = Map (Credential 'Staking crypto) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking crypto) Coin
s
    (Stake Map (Credential 'Staking crypto) Coin
s) = KeyHash 'StakePool crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
forall crypto.
KeyHash 'StakePool crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
-> Stake crypto
-> Stake crypto
poolStake KeyHash 'StakePool crypto
hash (SnapShot crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
forall crypto.
SnapShot crypto
-> Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_delegations SnapShot crypto
ss) (SnapShot crypto -> Stake crypto
forall crypto. SnapShot crypto -> Stake crypto
_stake SnapShot crypto
ss)

-- | Sum the active stake from a snapshot
getAllStake :: SnapShot crypto -> Integer
getAllStake :: SnapShot crypto -> Integer
getAllStake (SnapShot Stake crypto
stake Map (Credential 'Staking crypto) (KeyHash 'StakePool crypto)
_ Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_) = Integer
activeStake
  where
    Coin Integer
activeStake = Map (Credential 'Staking crypto) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Credential 'Staking crypto) Coin -> Coin)
-> (Stake crypto -> Map (Credential 'Staking crypto) Coin)
-> Stake crypto
-> Coin
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Stake crypto -> Map (Credential 'Staking crypto) Coin
forall crypto.
Stake crypto -> Map (Credential 'Staking crypto) Coin
unStake (Stake crypto -> Coin) -> Stake crypto -> Coin
forall a b. (a -> b) -> a -> b
$ Stake crypto
stake

-- | This function obtains the pool parameters, equivalent to the following jq query on the output of query ledger-state
--   .nesEs.esLState._delegationState._pstate._pParams.<pool_id>
writePoolParams :: forall era ledgerera. ()
  => ShelleyLedgerEra era ~ ledgerera
  => FromCBOR (DebugLedgerState era)
  => Crypto.Crypto (Era.Crypto ledgerera)
  => Era.Crypto ledgerera ~ StandardCrypto
  => PoolId
  -> SerialisedDebugLedgerState era
  -> ExceptT ShelleyQueryCmdError IO ()
writePoolParams :: Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT ShelleyQueryCmdError IO ()
writePoolParams (StakePoolKeyHash hk) SerialisedDebugLedgerState era
qState =
  case SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
forall era.
FromCBOR (DebugLedgerState era) =>
SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
decodeLedgerState SerialisedDebugLedgerState era
qState of
    -- In the event of decode failure print the CBOR instead
    Left ByteString
bs -> (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs

    Right DebugLedgerState era
ledgerState -> do
      let DebugLedgerState NewEpochState ledgerera
snapshot = DebugLedgerState era
ledgerState
      let poolState :: PState StandardCrypto
poolState = DPState StandardCrypto -> PState StandardCrypto
forall crypto. DPState crypto -> PState crypto
_pstate (DPState StandardCrypto -> PState StandardCrypto)
-> DPState StandardCrypto -> PState StandardCrypto
forall a b. (a -> b) -> a -> b
$ LedgerState ledgerera -> DPState (Crypto ledgerera)
forall era. LedgerState era -> DPState (Crypto era)
_delegationState (LedgerState ledgerera -> DPState (Crypto ledgerera))
-> LedgerState ledgerera -> DPState (Crypto ledgerera)
forall a b. (a -> b) -> a -> b
$ EpochState ledgerera -> LedgerState ledgerera
forall era. EpochState era -> LedgerState era
esLState (EpochState ledgerera -> LedgerState ledgerera)
-> EpochState ledgerera -> LedgerState ledgerera
forall a b. (a -> b) -> a -> b
$ NewEpochState ledgerera -> EpochState ledgerera
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState ledgerera
snapshot

      -- Pool parameters
      let poolParams :: Maybe (PoolParams StandardCrypto)
poolParams = KeyHash 'StakePool StandardCrypto
-> Map
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool StandardCrypto
hk (Map
   (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
 -> Maybe (PoolParams StandardCrypto))
-> Map
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
forall a b. (a -> b) -> a -> b
$ PState StandardCrypto
-> Map
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
forall crypto.
PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_pParams PState StandardCrypto
poolState
      let fPoolParams :: Maybe (PoolParams StandardCrypto)
fPoolParams = KeyHash 'StakePool StandardCrypto
-> Map
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool StandardCrypto
hk (Map
   (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
 -> Maybe (PoolParams StandardCrypto))
-> Map
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
forall a b. (a -> b) -> a -> b
$ PState StandardCrypto
-> Map
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
forall crypto.
PState crypto
-> Map (KeyHash 'StakePool crypto) (PoolParams crypto)
_fPParams PState StandardCrypto
poolState
      let retiring :: Maybe EpochNo
retiring = KeyHash 'StakePool StandardCrypto
-> Map (KeyHash 'StakePool StandardCrypto) EpochNo -> Maybe EpochNo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool StandardCrypto
hk (Map (KeyHash 'StakePool StandardCrypto) EpochNo -> Maybe EpochNo)
-> Map (KeyHash 'StakePool StandardCrypto) EpochNo -> Maybe EpochNo
forall a b. (a -> b) -> a -> b
$ PState StandardCrypto
-> Map (KeyHash 'StakePool StandardCrypto) EpochNo
forall crypto.
PState crypto -> Map (KeyHash 'StakePool crypto) EpochNo
_retiring PState StandardCrypto
poolState

      IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Params StandardCrypto -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Params StandardCrypto -> ByteString)
-> Params StandardCrypto -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe (PoolParams StandardCrypto)
-> Maybe (PoolParams StandardCrypto)
-> Maybe EpochNo
-> Params StandardCrypto
forall crypto.
Maybe (PoolParams crypto)
-> Maybe (PoolParams crypto) -> Maybe EpochNo -> Params crypto
Params Maybe (PoolParams StandardCrypto)
poolParams Maybe (PoolParams StandardCrypto)
fPoolParams Maybe EpochNo
retiring

decodeLedgerState :: forall era. ()
  => FromCBOR (DebugLedgerState era)
  => SerialisedDebugLedgerState era
  -> Either LBS.ByteString (DebugLedgerState era)
decodeLedgerState :: SerialisedDebugLedgerState era
-> Either ByteString (DebugLedgerState era)
decodeLedgerState (SerialisedDebugLedgerState (Serialised ByteString
ls)) = (DecoderError -> ByteString)
-> Either DecoderError (DebugLedgerState era)
-> Either ByteString (DebugLedgerState era)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> DecoderError -> ByteString
forall a b. a -> b -> a
const ByteString
ls) (ByteString -> Either DecoderError (DebugLedgerState era)
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull ByteString
ls)

writeProtocolState :: Crypto.Crypto StandardCrypto
                   => Maybe OutputFile
                   -> ProtocolState era
                   -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolState :: Maybe OutputFile
-> ProtocolState era -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolState Maybe OutputFile
mOutFile ps :: ProtocolState era
ps@(ProtocolState Serialised (ChainDepState (Crypto (ShelleyLedgerEra era)))
pstate) =
  case Maybe OutputFile
mOutFile of
    Maybe OutputFile
Nothing -> case ProtocolState era
-> Either ByteString (ChainDepState StandardCrypto)
forall era.
ProtocolState era
-> Either ByteString (ChainDepState StandardCrypto)
decodeProtocolState ProtocolState era
ps of
                 Left ByteString
bs -> (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
                 Right ChainDepState StandardCrypto
chainDepstate -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO ()
LBS.putStrLn (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ChainDepState StandardCrypto -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ChainDepState StandardCrypto
chainDepstate
    Just (OutputFile String
fpath) ->
      (IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
        (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ShelleyQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ByteString -> IO ()
LBS.writeFile String
fpath (ByteString -> ExceptT ShelleyQueryCmdError IO ())
-> ByteString -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Serialised (ChainDepState (Crypto (ShelleyLedgerEra era)))
-> ByteString
forall a. Serialised a -> ByteString
unSerialised Serialised (ChainDepState (Crypto (ShelleyLedgerEra era)))
pstate
 where
  decodeProtocolState
    :: ProtocolState era
    -> Either LBS.ByteString (Ledger.ChainDepState StandardCrypto)
  decodeProtocolState :: ProtocolState era
-> Either ByteString (ChainDepState StandardCrypto)
decodeProtocolState (ProtocolState (Serialised ByteString
pbs)) =
    (DecoderError -> ByteString)
-> Either DecoderError (ChainDepState StandardCrypto)
-> Either ByteString (ChainDepState StandardCrypto)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> DecoderError -> ByteString
forall a b. a -> b -> a
const ByteString
pbs) (ByteString -> Either DecoderError (ChainDepState StandardCrypto)
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull ByteString
pbs)

writeFilteredUTxOs :: ShelleyBasedEra era
                   -> Maybe OutputFile
                   -> UTxO era
                   -> ExceptT ShelleyQueryCmdError IO ()
writeFilteredUTxOs :: ShelleyBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT ShelleyQueryCmdError IO ()
writeFilteredUTxOs ShelleyBasedEra era
shelleyBasedEra' Maybe OutputFile
mOutFile UTxO era
utxo =
    case Maybe OutputFile
mOutFile of
      Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> UTxO era -> IO ()
forall era. ShelleyBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs ShelleyBasedEra era
shelleyBasedEra' UTxO era
utxo
      Just (OutputFile String
fpath) ->
        case ShelleyBasedEra era
shelleyBasedEra' of
          ShelleyBasedEra era
ShelleyBasedEraShelley -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
          ShelleyBasedEra era
ShelleyBasedEraAllegra -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
          ShelleyBasedEra era
ShelleyBasedEraMary -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
          ShelleyBasedEra era
ShelleyBasedEraAlonzo -> String -> UTxO era -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
 where
   writeUTxo :: String -> a -> ExceptT ShelleyQueryCmdError m ()
writeUTxo String
fpath a
utxo' =
     (IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
       (IO () -> ExceptT ShelleyQueryCmdError m ())
-> IO () -> ExceptT ShelleyQueryCmdError m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (a -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty a
utxo')

printFilteredUTxOs :: ShelleyBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs :: ShelleyBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs ShelleyBasedEra era
shelleyBasedEra' (UTxO Map TxIn (TxOut era)
utxo) = do
  Text -> IO ()
Text.putStrLn Text
title
  String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
'-'
  case ShelleyBasedEra era
shelleyBasedEra' of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      ((TxIn, TxOut era) -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
forall era. ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut era)] -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> [(TxIn, TxOut era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut era)
utxo
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      ((TxIn, TxOut era) -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
forall era. ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut era)] -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> [(TxIn, TxOut era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut era)
utxo
    ShelleyBasedEra era
ShelleyBasedEraMary    ->
      ((TxIn, TxOut era) -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
forall era. ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut era)] -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> [(TxIn, TxOut era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut era)
utxo
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      ((TxIn, TxOut era) -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
forall era. ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra') ([(TxIn, TxOut era)] -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> [(TxIn, TxOut era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut era)
utxo
 where
   title :: Text
   title :: Text
title =
     Text
"                           TxHash                                 TxIx        Amount"

printUtxo
  :: ShelleyBasedEra era
  -> (TxIn, TxOut era)
  -> IO ()
printUtxo :: ShelleyBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo ShelleyBasedEra era
shelleyBasedEra' (TxIn, TxOut era)
txInOutTuple =
  case ShelleyBasedEra era
shelleyBasedEra' of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatumHash era
_) = (TxIn, TxOut era)
txInOutTuple
      in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
           [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
             [ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
txhash)
             , Int -> Word -> Text
forall a. Show a => Int -> a -> Text
textShowN Int
6 Word
index
             , Text
"        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxOutValue era -> Text
forall era. TxOutValue era -> Text
printableValue TxOutValue era
value
             ]

    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatumHash era
_) = (TxIn, TxOut era)
txInOutTuple
      in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
           [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
             [ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
txhash)
             , Int -> Word -> Text
forall a. Show a => Int -> a -> Text
textShowN Int
6 Word
index
             , Text
"        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxOutValue era -> Text
forall era. TxOutValue era -> Text
printableValue TxOutValue era
value
             ]
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatumHash era
_) = (TxIn, TxOut era)
txInOutTuple
      in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
           [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
             [ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
txhash)
             , Int -> Word -> Text
forall a. Show a => Int -> a -> Text
textShowN Int
6 Word
index
             , Text
"        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxOutValue era -> Text
forall era. TxOutValue era -> Text
printableValue TxOutValue era
value
             ]
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      let (TxIn (TxId Hash StandardCrypto EraIndependentTxBody
txhash) (TxIx Word
index), TxOut AddressInEra era
_ TxOutValue era
value TxOutDatumHash era
mDatum) = (TxIn, TxOut era)
txInOutTuple
      in Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
           [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
             [ ByteString -> Text
Text.decodeLatin1 (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
txhash)
             , Int -> Word -> Text
forall a. Show a => Int -> a -> Text
textShowN Int
6 Word
index
             , Text
"        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxOutValue era -> Text
forall era. TxOutValue era -> Text
printableValue TxOutValue era
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" + " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (TxOutDatumHash era -> String
forall a b. (Show a, ConvertText String b) => a -> b
show TxOutDatumHash era
mDatum)
             ]
 where
  textShowN :: Show a => Int -> a -> Text
  textShowN :: Int -> a -> Text
textShowN Int
len a
x =
    let str :: String
str = a -> String
forall a b. (Show a, ConvertText String b) => a -> b
show a
x
        slen :: Int
slen = String -> Int
forall a. HasLength a => a -> Int
length String
str
    in String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
slen)) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str

  printableValue :: TxOutValue era -> Text
  printableValue :: TxOutValue era -> Text
printableValue (TxOutValue MultiAssetSupportedInEra era
_ Value
val) = Value -> Text
renderValue Value
val
  printableValue (TxOutAdaOnly OnlyAdaSupportedInEra era
_ (Lovelace Integer
i)) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Integer
i


runQueryStakeDistribution
  :: AnyConsensusModeParams
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
                          NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath

  anyE :: AnyCardanoEra
anyE@(AnyCardanoEra CardanoEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo
  let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
  ShelleyBasedEra era
sbe <- CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall era.
CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe (CardanoEraStyle era
 -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era))
-> CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> CardanoEraStyle era
forall era. CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
era

  case CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
cMode of
    Just EraInMode era mode
eInMode -> do
      let query :: QueryInMode
  mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
query = EraInMode era mode
-> QueryInEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
     mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode
                    (QueryInEra era (Map (Hash StakePoolKey) Rational)
 -> QueryInMode
      mode (Either EraMismatch (Map (Hash StakePoolKey) Rational)))
-> (QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
    -> QueryInEra era (Map (Hash StakePoolKey) Rational))
-> QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
     mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInEra era (Map (Hash StakePoolKey) Rational)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
                    (QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
 -> QueryInMode
      mode (Either EraMismatch (Map (Hash StakePoolKey) Rational)))
-> QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
     mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
forall a b. (a -> b) -> a -> b
$ QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
forall era.
QueryInShelleyBasedEra era (Map (Hash StakePoolKey) Rational)
QueryStakeDistribution
      Map (Hash StakePoolKey) Rational
result <- CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
     mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
-> ExceptT
     ShelleyQueryCmdError IO (Map (Hash StakePoolKey) Rational)
forall result era mode.
CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery
                  CardanoEra era
era
                  ConsensusModeParams mode
cModeParams
                  LocalNodeConnectInfo mode
localNodeConnInfo
                  QueryInMode
  mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
query
      Maybe OutputFile
-> Map (Hash StakePoolKey) Rational
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution Maybe OutputFile
mOutFile Map (Hash StakePoolKey) Rational
result
    Maybe (EraInMode era mode)
Nothing -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ())
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyCardanoEra
anyE


writeStakeDistribution
  :: Maybe OutputFile
  -> Map PoolId Rational
  -> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution :: Maybe OutputFile
-> Map (Hash StakePoolKey) Rational
-> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution (Just (OutputFile String
outFile)) Map (Hash StakePoolKey) Rational
stakeDistrib =
  (IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
outFile) (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    String -> ByteString -> IO ()
LBS.writeFile String
outFile (Map (Hash StakePoolKey) Rational -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map (Hash StakePoolKey) Rational
stakeDistrib)

writeStakeDistribution Maybe OutputFile
Nothing Map (Hash StakePoolKey) Rational
stakeDistrib =
  IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Map (Hash StakePoolKey) Rational -> IO ()
printStakeDistribution Map (Hash StakePoolKey) Rational
stakeDistrib


printStakeDistribution :: Map PoolId Rational -> IO ()
printStakeDistribution :: Map (Hash StakePoolKey) Rational -> IO ()
printStakeDistribution Map (Hash StakePoolKey) Rational
stakeDistrib = do
  Text -> IO ()
Text.putStrLn Text
title
  String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
'-'
  [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
    [ String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Hash StakePoolKey -> Rational -> String
showStakeDistr Hash StakePoolKey
poolId Rational
stakeFraction
    | (Hash StakePoolKey
poolId, Rational
stakeFraction) <- Map (Hash StakePoolKey) Rational -> [(Hash StakePoolKey, Rational)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Hash StakePoolKey) Rational
stakeDistrib ]
 where
   title :: Text
   title :: Text
title =
     Text
"                           PoolId                                 Stake frac"

   showStakeDistr :: PoolId
                  -> Rational
                  -- ^ Stake fraction
                  -> String
   showStakeDistr :: Hash StakePoolKey -> Rational -> String
showStakeDistr Hash StakePoolKey
poolId Rational
stakeFraction =
     [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
       [ Text -> String
Text.unpack (Hash StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Hash StakePoolKey
poolId)
       , String
"   "
       , Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
stakeFraction :: Double) String
""
       ]

-- | A mapping of Shelley reward accounts to both the stake pool that they
-- delegate to and their reward account balance.
newtype DelegationsAndRewards
  = DelegationsAndRewards (Map StakeAddress Lovelace, Map StakeAddress PoolId)


mergeDelegsAndRewards :: DelegationsAndRewards -> [(StakeAddress, Maybe Lovelace, Maybe PoolId)]
mergeDelegsAndRewards :: DelegationsAndRewards
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
mergeDelegsAndRewards (DelegationsAndRewards (Map StakeAddress Lovelace
rewardsMap, Map StakeAddress (Hash StakePoolKey)
delegMap)) =
 [ (StakeAddress
stakeAddr, StakeAddress -> Map StakeAddress Lovelace -> Maybe Lovelace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
stakeAddr Map StakeAddress Lovelace
rewardsMap, StakeAddress
-> Map StakeAddress (Hash StakePoolKey)
-> Maybe (Hash StakePoolKey)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
stakeAddr Map StakeAddress (Hash StakePoolKey)
delegMap)
 | StakeAddress
stakeAddr <- [StakeAddress] -> [StakeAddress]
forall a. Eq a => [a] -> [a]
nub ([StakeAddress] -> [StakeAddress])
-> [StakeAddress] -> [StakeAddress]
forall a b. (a -> b) -> a -> b
$ Map StakeAddress Lovelace -> [StakeAddress]
forall k a. Map k a -> [k]
Map.keys Map StakeAddress Lovelace
rewardsMap [StakeAddress] -> [StakeAddress] -> [StakeAddress]
forall a. [a] -> [a] -> [a]
++ Map StakeAddress (Hash StakePoolKey) -> [StakeAddress]
forall k a. Map k a -> [k]
Map.keys Map StakeAddress (Hash StakePoolKey)
delegMap
 ]


instance ToJSON DelegationsAndRewards where
  toJSON :: DelegationsAndRewards -> Value
toJSON DelegationsAndRewards
delegsAndRwds =
      Array -> Value
Aeson.Array (Array -> Value)
-> ([(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
    -> Array)
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList
        ([Value] -> Array)
-> ([(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
    -> [Value])
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> Array
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))
 -> Value)
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)) -> Value
delegAndRwdToJson ([(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
 -> Value)
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
-> Value
forall a b. (a -> b) -> a -> b
$ DelegationsAndRewards
-> [(StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey))]
mergeDelegsAndRewards DelegationsAndRewards
delegsAndRwds
    where
      delegAndRwdToJson :: (StakeAddress, Maybe Lovelace, Maybe PoolId) -> Aeson.Value
      delegAndRwdToJson :: (StakeAddress, Maybe Lovelace, Maybe (Hash StakePoolKey)) -> Value
delegAndRwdToJson (StakeAddress
addr, Maybe Lovelace
mRewards, Maybe (Hash StakePoolKey)
mPoolId) =
        [Pair] -> Value
Aeson.object
          [ Text
"address" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StakeAddress -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress StakeAddress
addr
          , Text
"delegation" Text -> Maybe (Hash StakePoolKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (Hash StakePoolKey)
mPoolId
          , Text
"rewardAccountBalance" Text -> Maybe Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Lovelace
mRewards
          ]

-- Helpers

calcEraInMode
  :: CardanoEra era
  -> ConsensusMode mode
  -> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
calcEraInMode :: CardanoEra era
-> ConsensusMode mode
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
calcEraInMode CardanoEra era
era ConsensusMode mode
mode=
  ShelleyQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyCardanoEra -> ShelleyQueryCmdError
ShelleyQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode) (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era))
                   (Maybe (EraInMode era mode)
 -> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> Maybe (EraInMode era mode)
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode CardanoEra era
era ConsensusMode mode
mode

determineEra
  :: ConsensusModeParams mode
  -> LocalNodeConnectInfo mode
  -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra :: ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
determineEra ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo =
  case ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams of
    ConsensusMode mode
ByronMode -> AnyCardanoEra -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra)
-> AnyCardanoEra -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
    ConsensusMode mode
ShelleyMode -> AnyCardanoEra -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCardanoEra -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra)
-> AnyCardanoEra -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
    ConsensusMode mode
CardanoMode -> do
      Either AcquireFailure AnyCardanoEra
eraQ <- IO (Either AcquireFailure AnyCardanoEra)
-> ExceptT
     ShelleyQueryCmdError IO (Either AcquireFailure AnyCardanoEra)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either AcquireFailure AnyCardanoEra)
 -> ExceptT
      ShelleyQueryCmdError IO (Either AcquireFailure AnyCardanoEra))
-> (QueryInMode CardanoMode AnyCardanoEra
    -> IO (Either AcquireFailure AnyCardanoEra))
-> QueryInMode CardanoMode AnyCardanoEra
-> ExceptT
     ShelleyQueryCmdError IO (Either AcquireFailure AnyCardanoEra)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode AnyCardanoEra
-> IO (Either AcquireFailure AnyCardanoEra)
forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquireFailure result)
queryNodeLocalState LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing
                     (QueryInMode CardanoMode AnyCardanoEra
 -> ExceptT
      ShelleyQueryCmdError IO (Either AcquireFailure AnyCardanoEra))
-> QueryInMode CardanoMode AnyCardanoEra
-> ExceptT
     ShelleyQueryCmdError IO (Either AcquireFailure AnyCardanoEra)
forall a b. (a -> b) -> a -> b
$ ConsensusModeIsMultiEra CardanoMode
-> QueryInMode CardanoMode AnyCardanoEra
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode AnyCardanoEra
QueryCurrentEra ConsensusModeIsMultiEra CardanoMode
CardanoModeIsMultiEra
      case Either AcquireFailure AnyCardanoEra
eraQ of
        Left AcquireFailure
acqFail -> ShelleyQueryCmdError
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError
 -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra)
-> ShelleyQueryCmdError
-> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ AcquireFailure -> ShelleyQueryCmdError
ShelleyQueryCmdAcquireFailure AcquireFailure
acqFail
        Right AnyCardanoEra
anyCarEra -> AnyCardanoEra -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
forall (m :: * -> *) a. Monad m => a -> m a
return AnyCardanoEra
anyCarEra

executeQuery
  :: forall result era mode. CardanoEra era
  -> ConsensusModeParams mode
  -> LocalNodeConnectInfo mode
  -> QueryInMode mode (Either EraMismatch result)
  -> ExceptT ShelleyQueryCmdError IO result
executeQuery :: CardanoEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
executeQuery CardanoEra era
era ConsensusModeParams mode
cModeP LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch result)
q = do
  EraInMode era mode
eraInMode <- CardanoEra era
-> ConsensusMode mode
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall era mode.
CardanoEra era
-> ConsensusMode mode
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
calcEraInMode CardanoEra era
era (ConsensusMode mode
 -> ExceptT ShelleyQueryCmdError IO (EraInMode era mode))
-> ConsensusMode mode
-> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
forall a b. (a -> b) -> a -> b
$ ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeP
  case EraInMode era mode
eraInMode of
    EraInMode era mode
ByronEraInByronMode -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO result
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyQueryCmdError
ShelleyQueryCmdByronEra
    EraInMode era mode
_ -> IO (Either AcquireFailure (Either EraMismatch result))
-> ExceptT
     ShelleyQueryCmdError
     IO
     (Either AcquireFailure (Either EraMismatch result))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either AcquireFailure (Either EraMismatch result))
execQuery ExceptT
  ShelleyQueryCmdError
  IO
  (Either AcquireFailure (Either EraMismatch result))
-> (Either AcquireFailure (Either EraMismatch result)
    -> ExceptT ShelleyQueryCmdError IO result)
-> ExceptT ShelleyQueryCmdError IO result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either AcquireFailure (Either EraMismatch result)
-> ExceptT ShelleyQueryCmdError IO result
forall a.
Either AcquireFailure (Either EraMismatch a)
-> ExceptT ShelleyQueryCmdError IO a
queryResult
 where
   execQuery :: IO (Either AcquireFailure (Either EraMismatch result))
   execQuery :: IO (Either AcquireFailure (Either EraMismatch result))
execQuery = LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode (Either EraMismatch result)
-> IO (Either AcquireFailure (Either EraMismatch result))
forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquireFailure result)
queryNodeLocalState LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing QueryInMode mode (Either EraMismatch result)
q

getSbe :: CardanoEraStyle era -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe :: CardanoEraStyle era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
getSbe CardanoEraStyle era
LegacyByronEra = ShelleyQueryCmdError
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyQueryCmdError
ShelleyQueryCmdByronEra
getSbe (ShelleyBasedEra ShelleyBasedEra era
sbe) = ShelleyBasedEra era
-> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyBasedEra era
sbe

queryResult
  :: Either AcquireFailure (Either EraMismatch a)
  -> ExceptT ShelleyQueryCmdError IO a
queryResult :: Either AcquireFailure (Either EraMismatch a)
-> ExceptT ShelleyQueryCmdError IO a
queryResult Either AcquireFailure (Either EraMismatch a)
eAcq =
  case Either AcquireFailure (Either EraMismatch a)
eAcq of
    Left AcquireFailure
acqFailure -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO a)
-> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO a
forall a b. (a -> b) -> a -> b
$ AcquireFailure -> ShelleyQueryCmdError
ShelleyQueryCmdAcquireFailure AcquireFailure
acqFailure
    Right Either EraMismatch a
eResult ->
      case Either EraMismatch a
eResult of
        Left EraMismatch
err -> ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ShelleyQueryCmdError -> ExceptT ShelleyQueryCmdError IO a)
-> (ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError)
-> ShelleyQueryCmdLocalStateQueryError
-> ExceptT ShelleyQueryCmdError IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError
ShelleyQueryCmdLocalStateQueryError (ShelleyQueryCmdLocalStateQueryError
 -> ExceptT ShelleyQueryCmdError IO a)
-> ShelleyQueryCmdLocalStateQueryError
-> ExceptT ShelleyQueryCmdError IO a
forall a b. (a -> b) -> a -> b
$ EraMismatch -> ShelleyQueryCmdLocalStateQueryError
EraMismatchError EraMismatch
err
        Right a
result -> a -> ExceptT ShelleyQueryCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

obtainLedgerEraClassConstraints
  :: ShelleyLedgerEra era ~ ledgerera
  => ShelleyBasedEra era
  -> ((Ledger.ShelleyBased ledgerera
      , ToJSON (DebugLedgerState era)
      , FromCBOR (DebugLedgerState era)
      , Era.Crypto ledgerera ~ StandardCrypto
      ) => a) -> a
obtainLedgerEraClassConstraints :: ShelleyBasedEra era
-> ((ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
     FromCBOR (DebugLedgerState era),
     Crypto ledgerera ~ StandardCrypto) =>
    a)
-> a
obtainLedgerEraClassConstraints ShelleyBasedEra era
ShelleyBasedEraShelley (ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era),
 Crypto ledgerera ~ StandardCrypto) =>
a
f = a
(ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era),
 Crypto ledgerera ~ StandardCrypto) =>
a
f
obtainLedgerEraClassConstraints ShelleyBasedEra era
ShelleyBasedEraAllegra (ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era),
 Crypto ledgerera ~ StandardCrypto) =>
a
f = a
(ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era),
 Crypto ledgerera ~ StandardCrypto) =>
a
f
obtainLedgerEraClassConstraints ShelleyBasedEra era
ShelleyBasedEraMary    (ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era),
 Crypto ledgerera ~ StandardCrypto) =>
a
f = a
(ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era),
 Crypto ledgerera ~ StandardCrypto) =>
a
f
obtainLedgerEraClassConstraints ShelleyBasedEra era
ShelleyBasedEraAlonzo  (ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era),
 Crypto ledgerera ~ StandardCrypto) =>
a
f = a
(ShelleyBased ledgerera, ToJSON (DebugLedgerState era),
 FromCBOR (DebugLedgerState era),
 Crypto ledgerera ~ StandardCrypto) =>
a
f