{-# 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 Bcc.CLI.Sophie.Run.Query
( SophieQueryCmdError
, SophieQueryCmdLocalStateQueryError (..)
, renderSophieQueryCmdError
, renderLocalStateQueryError
, runQueryCmd
, percentage
, executeQuery
, queryQueryTip
) where
import Bcc.Api
import Bcc.Api.Cole
import Bcc.Api.Sophie
import Bcc.Binary (decodeFull)
import Bcc.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import Bcc.CLI.Helpers (HelpersError (..), hushM, pPrintCBOR, renderHelpersError)
import Bcc.CLI.Sophie.Orphans ()
import Bcc.CLI.Sophie.Parsers (OutputFile (..), QueryCmd (..))
import Bcc.CLI.Types
import Bcc.Crypto.Hash (hashToBytesAsHex)
import Bcc.Ledger.Coin
import Bcc.Ledger.Crypto (StandardCrypto)
import Bcc.Ledger.Keys (KeyHash (..), KeyRole (..))
import Bcc.Prelude hiding (atomically)
import Bcc.Slotting.EpochInfo (hoistEpochInfo)
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 Shardagnostic.Consensus.BlockchainTime.WallClock.Types (RelativeTime (..),
SystemStart (..), toRelativeTime)
import Shardagnostic.Consensus.Bcc.Block as Consensus (EraMismatch (..))
import qualified Shardagnostic.Consensus.HardFork.History as Consensus
import Shardagnostic.Network.Block (Serialised (..))
import Shardagnostic.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..))
import Prelude (String, id)
import Sophie.Spec.Ledger.EpochBoundary
import Sophie.Spec.Ledger.LedgerState hiding (_delegations)
import Sophie.Spec.Ledger.Scripts ()
import Text.Printf (printf)
import qualified Bcc.CLI.Sophie.Output as O
import qualified Bcc.Ledger.Crypto as Crypto
import qualified Bcc.Ledger.Era as Era
import qualified Bcc.Ledger.Sophie.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 Shardagnostic.Consensus.HardFork.History.Qry as Qry
import qualified Shardagnostic.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
import qualified Sophie.Spec.Ledger.API.Protocol as Ledger
import qualified System.IO as IO
data SophieQueryCmdError
= SophieQueryCmdEnvVarSocketErr !EnvSocketError
| SophieQueryCmdLocalStateQueryError !SophieQueryCmdLocalStateQueryError
| SophieQueryCmdWriteFileError !(FileError ())
| SophieQueryCmdHelpersError !HelpersError
| SophieQueryCmdAcquireFailure !AcquireFailure
| SophieQueryCmdEraConsensusModeMismatch !AnyConsensusMode !AnyBccEra
| SophieQueryCmdColeEra
| SophieQueryCmdPoolIdError (Hash StakePoolKey)
| SophieQueryCmdEraMismatch !EraMismatch
| SophieQueryCmdUnsupportedMode !AnyConsensusMode
| SophieQueryCmdPastHorizon !Qry.PastHorizonException
| SophieQueryCmdSystemStartUnavailable
deriving Int -> SophieQueryCmdError -> ShowS
[SophieQueryCmdError] -> ShowS
SophieQueryCmdError -> String
(Int -> SophieQueryCmdError -> ShowS)
-> (SophieQueryCmdError -> String)
-> ([SophieQueryCmdError] -> ShowS)
-> Show SophieQueryCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SophieQueryCmdError] -> ShowS
$cshowList :: [SophieQueryCmdError] -> ShowS
show :: SophieQueryCmdError -> String
$cshow :: SophieQueryCmdError -> String
showsPrec :: Int -> SophieQueryCmdError -> ShowS
$cshowsPrec :: Int -> SophieQueryCmdError -> ShowS
Show
renderSophieQueryCmdError :: SophieQueryCmdError -> Text
renderSophieQueryCmdError :: SophieQueryCmdError -> Text
renderSophieQueryCmdError SophieQueryCmdError
err =
case SophieQueryCmdError
err of
SophieQueryCmdEnvVarSocketErr EnvSocketError
envSockErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
envSockErr
SophieQueryCmdLocalStateQueryError SophieQueryCmdLocalStateQueryError
lsqErr -> SophieQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError SophieQueryCmdLocalStateQueryError
lsqErr
SophieQueryCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
SophieQueryCmdHelpersError HelpersError
helpersErr -> HelpersError -> Text
renderHelpersError HelpersError
helpersErr
SophieQueryCmdAcquireFailure 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
SophieQueryCmdError
SophieQueryCmdColeEra -> Text
"This query cannot be used for the Cole era"
SophieQueryCmdPoolIdError 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
SophieQueryCmdEraConsensusModeMismatch (AnyConsensusMode ConsensusMode mode
cMode) (AnyBccEra BccEra 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
<> BccEra era -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show BccEra era
era
SophieQueryCmdEraMismatch (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
SophieQueryCmdUnsupportedMode AnyConsensusMode
mode -> Text
"Unsupported mode: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AnyConsensusMode -> Text
renderMode AnyConsensusMode
mode
SophieQueryCmdPastHorizon 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
SophieQueryCmdError
SophieQueryCmdSystemStartUnavailable -> Text
"System start unavailable"
runQueryCmd :: QueryCmd -> ExceptT SophieQueryCmdError IO ()
runQueryCmd :: QueryCmd -> ExceptT SophieQueryCmdError IO ()
runQueryCmd QueryCmd
cmd =
case QueryCmd
cmd of
QueryProtocolParameters' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryProtocolParameters AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryTip AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryTip AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryStakePools' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryStakePools AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryStakeDistribution' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ()
runQueryStakeAddressInfo AnyConsensusModeParams
consensusModeParams StakeAddress
addr NetworkId
network Maybe OutputFile
mOutFile
QueryDebugLedgerState' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryLedgerState AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile
QueryStakeSnapshot' AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid ->
AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT SophieQueryCmdError IO ()
runQueryStakeSnapshot AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid
QueryPoolParams' AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid ->
AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT SophieQueryCmdError IO ()
runQueryPoolParams AnyConsensusModeParams
consensusModeParams NetworkId
network Hash StakePoolKey
poolid
QueryProtocolState' AnyConsensusModeParams
consensusModeParams NetworkId
network Maybe OutputFile
mOutFile ->
AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ()
runQueryUTxO AnyConsensusModeParams
consensusModeParams QueryUTxOFilter
qFilter NetworkId
networkId Maybe OutputFile
mOutFile
runQueryProtocolParameters
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryProtocolParameters :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryProtocolParameters (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr
ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters)
result <- IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters))
-> ExceptT
SophieQueryCmdError
IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters))
-> ExceptT
SophieQueryCmdError
IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters)))
-> IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters))
-> ExceptT
SophieQueryCmdError
IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError ProtocolParameters))
-> IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters))
forall mode a.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (Either AcquireFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing ((NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError ProtocolParameters))
-> IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters)))
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError ProtocolParameters))
-> IO
(Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters))
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
_ntcVersion -> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError ProtocolParameters)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError ProtocolParameters))
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ do
anyE :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra)
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra
forall a b. (a -> b) -> a -> b
$ ConsensusModeParams mode
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO AnyBccEra
forall mode block point r.
ConsensusModeParams mode
-> LocalStateQueryExpr
block point (QueryInMode mode) r IO AnyBccEra
determineEraExpr ConsensusModeParams mode
cModeParams
case BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era of
BccEraStyle era
LegacyColeEra -> SophieQueryCmdError
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left SophieQueryCmdError
SophieQueryCmdColeEra
SophieBasedEra SophieBasedEra era
sbe -> do
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
EraInMode era mode
eInMode <- BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra era
era ConsensusMode mode
cMode
Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(EraInMode era mode))
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(EraInMode era mode)
forall a b. a -> (a -> b) -> b
& SophieQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
anyE)
Either EraMismatch ProtocolParameters
ppResult <- LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch ProtocolParameters)
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch ProtocolParameters)
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters))
-> (QueryInMode mode (Either EraMismatch ProtocolParameters)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch ProtocolParameters))
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryInMode mode (Either EraMismatch ProtocolParameters)
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch ProtocolParameters)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters))
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ EraInMode era mode
-> QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> QueryInMode mode (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ SophieBasedEra era
-> QueryInSophieBasedEra era ProtocolParameters
-> QueryInEra era ProtocolParameters
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe QueryInSophieBasedEra era ProtocolParameters
forall era. QueryInSophieBasedEra era ProtocolParameters
QueryProtocolParameters
Either EraMismatch ProtocolParameters
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except Either EraMismatch ProtocolParameters
ppResult ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> (ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters)
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
forall a b. a -> (a -> b) -> b
& (EraMismatch -> SophieQueryCmdError)
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
ProtocolParameters
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> SophieQueryCmdError
SophieQueryCmdEraMismatch
Maybe OutputFile
-> ProtocolParameters -> ExceptT SophieQueryCmdError IO ()
writeProtocolParameters Maybe OutputFile
mOutFile (ProtocolParameters -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO ProtocolParameters
-> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either SophieQueryCmdError ProtocolParameters
-> ExceptT SophieQueryCmdError IO ProtocolParameters
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either
SophieQueryCmdError (Either SophieQueryCmdError ProtocolParameters)
-> Either SophieQueryCmdError ProtocolParameters
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((AcquireFailure -> SophieQueryCmdError)
-> Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters)
-> Either
SophieQueryCmdError (Either SophieQueryCmdError ProtocolParameters)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquireFailure -> SophieQueryCmdError
SophieQueryCmdAcquireFailure Either
AcquireFailure (Either SophieQueryCmdError ProtocolParameters)
result))
where
writeProtocolParameters
:: Maybe OutputFile
-> ProtocolParameters
-> ExceptT SophieQueryCmdError IO ()
writeProtocolParameters :: Maybe OutputFile
-> ProtocolParameters -> ExceptT SophieQueryCmdError IO ()
writeProtocolParameters Maybe OutputFile
mOutFile' ProtocolParameters
pparams =
case Maybe OutputFile
mOutFile' of
Maybe OutputFile
Nothing -> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError 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 -> SophieQueryCmdError)
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieQueryCmdError
SophieQueryCmdWriteFileError (FileError () -> SophieQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieQueryCmdError
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 SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
String -> ByteString -> IO ()
LBS.writeFile String
fpath (ProtocolParameters -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ProtocolParameters
pparams)
percentage
:: RelativeTime
-> RelativeTime
-> RelativeTime
-> Text
percentage :: RelativeTime -> RelativeTime -> RelativeTime -> Text
percentage RelativeTime
tolerance RelativeTime
a RelativeTime
b = String -> Text
Text.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f" Double
pc)
where
t :: Integer
t = RelativeTime -> Integer
relativeTimeSeconds RelativeTime
tolerance
sa :: Integer
sa = RelativeTime -> Integer
relativeTimeSeconds RelativeTime
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
sb :: Integer
sb = RelativeTime -> Integer
relativeTimeSeconds RelativeTime
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
ua :: Integer
ua = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Integer
sa Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
t) Integer
sb
ub :: Integer
ub = Integer
sb
pc :: Double
pc = Double -> Double
forall a. a -> a
id @Double (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ua Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ub) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100.0
relativeTimeSeconds :: RelativeTime -> Integer
relativeTimeSeconds :: RelativeTime -> Integer
relativeTimeSeconds (RelativeTime NominalDiffTime
dt) = Pico -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
dt)
runQueryTip
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryTip :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryTip (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
case ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams of
ConsensusMode mode
BccMode -> 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 QueryTipLocalState
eLocalState) <- IO (ChainTip, Either AcquireFailure QueryTipLocalState)
-> ExceptT
SophieQueryCmdError
IO
(ChainTip, Either AcquireFailure QueryTipLocalState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ChainTip, Either AcquireFailure QueryTipLocalState)
-> ExceptT
SophieQueryCmdError
IO
(ChainTip, Either AcquireFailure QueryTipLocalState))
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState)
-> ExceptT
SophieQueryCmdError
IO
(ChainTip, Either AcquireFailure QueryTipLocalState)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo BccMode
-> Maybe ChainPoint
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState)
queryQueryTip LocalNodeConnectInfo mode
LocalNodeConnectInfo BccMode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing
Maybe QueryTipLocalState
mLocalState <- Either SophieQueryCmdError QueryTipLocalState
-> (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalState)
forall e (m :: * -> *) a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM ((AcquireFailure -> SophieQueryCmdError)
-> Either AcquireFailure QueryTipLocalState
-> Either SophieQueryCmdError QueryTipLocalState
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquireFailure -> SophieQueryCmdError
SophieQueryCmdAcquireFailure Either AcquireFailure QueryTipLocalState
eLocalState) ((SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalState))
-> (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalState)
forall a b. (a -> b) -> a -> b
$ \SophieQueryCmdError
e ->
IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ())
-> Text -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Warning: Local state unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SophieQueryCmdError -> Text
renderSophieQueryCmdError SophieQueryCmdError
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
SophieQueryCmdError IO (Maybe (Maybe QueryTipLocalStateOutput))
-> ExceptT SophieQueryCmdError 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
SophieQueryCmdError IO (Maybe (Maybe QueryTipLocalStateOutput))
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ((QueryTipLocalState
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ExceptT
SophieQueryCmdError IO (Maybe (Maybe QueryTipLocalStateOutput)))
-> (QueryTipLocalState
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ExceptT
SophieQueryCmdError 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 SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> (QueryTipLocalState
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall a b. (a -> b) -> a -> b
$ \QueryTipLocalState
localState -> do
case SlotNo
-> EraHistory BccMode
-> Either
PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
forall mode.
SlotNo
-> EraHistory mode
-> Either
PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
slotToEpoch SlotNo
tipSlotNo (QueryTipLocalState -> EraHistory BccMode
O.eraHistory QueryTipLocalState
localState) of
Left PastHorizonException
e -> do
IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ())
-> Text -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
Text
"Warning: Epoch unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SophieQueryCmdError -> Text
renderSophieQueryCmdError (PastHorizonException -> SophieQueryCmdError
SophieQueryCmdPastHorizon PastHorizonException
e)
Maybe QueryTipLocalStateOutput
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError Text
syncProgressResult <- ExceptT SophieQueryCmdError (ExceptT SophieQueryCmdError IO) Text
-> ExceptT SophieQueryCmdError IO (Either SophieQueryCmdError Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT SophieQueryCmdError (ExceptT SophieQueryCmdError IO) Text
-> ExceptT
SophieQueryCmdError IO (Either SophieQueryCmdError Text))
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) Text
-> ExceptT SophieQueryCmdError IO (Either SophieQueryCmdError 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
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) UTCTime)
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) UTCTime
forall a b. a -> (a -> b) -> b
& SophieQueryCmdError
-> Maybe UTCTime
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) UTCTime
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe SophieQueryCmdError
SophieQueryCmdSystemStartUnavailable
RelativeTime
nowSeconds <- SystemStart -> UTCTime -> RelativeTime
toRelativeTime (UTCTime -> SystemStart
SystemStart UTCTime
systemStart) (UTCTime -> RelativeTime)
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) UTCTime
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
RelativeTime
tipTimeResult <- SlotNo
-> EraHistory BccMode
-> Either PastHorizonException (RelativeTime, SlotLength)
forall mode.
SlotNo
-> EraHistory mode
-> Either PastHorizonException (RelativeTime, SlotLength)
getProgress SlotNo
tipSlotNo (QueryTipLocalState -> EraHistory BccMode
O.eraHistory QueryTipLocalState
localState) Either PastHorizonException (RelativeTime, SlotLength)
-> (Either PastHorizonException (RelativeTime, SlotLength)
-> Either SophieQueryCmdError RelativeTime)
-> Either SophieQueryCmdError RelativeTime
forall a b. a -> (a -> b) -> b
& (PastHorizonException -> SophieQueryCmdError)
-> ((RelativeTime, SlotLength) -> RelativeTime)
-> Either PastHorizonException (RelativeTime, SlotLength)
-> Either SophieQueryCmdError RelativeTime
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap PastHorizonException -> SophieQueryCmdError
SophieQueryCmdPastHorizon (RelativeTime, SlotLength) -> RelativeTime
forall a b. (a, b) -> a
fst Either SophieQueryCmdError RelativeTime
-> (Either SophieQueryCmdError RelativeTime
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) RelativeTime)
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) RelativeTime
forall a b. a -> (a -> b) -> b
& Either SophieQueryCmdError RelativeTime
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError 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
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError IO) Text)
-> Text
-> ExceptT
SophieQueryCmdError (ExceptT SophieQueryCmdError 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 SophieQueryCmdError Text
-> (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO (Maybe Text)
forall e (m :: * -> *) a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM Either SophieQueryCmdError Text
syncProgressResult ((SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO (Maybe Text))
-> (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \SophieQueryCmdError
e -> do
IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> (Text -> IO ()) -> Text -> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ())
-> Text -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Warning: Sync progress unavailable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SophieQueryCmdError -> Text
renderSophieQueryCmdError SophieQueryCmdError
e
Maybe QueryTipLocalStateOutput
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe QueryTipLocalStateOutput
-> ExceptT SophieQueryCmdError IO (Maybe QueryTipLocalStateOutput))
-> Maybe QueryTipLocalStateOutput
-> ExceptT SophieQueryCmdError 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 AnyBccEra
-> Maybe EpochNo -> Maybe Text -> QueryTipLocalStateOutput
O.QueryTipLocalStateOutput
{ $sel:mEra:QueryTipLocalStateOutput :: Maybe AnyBccEra
O.mEra = AnyBccEra -> Maybe AnyBccEra
forall a. a -> Maybe a
Just (QueryTipLocalState -> AnyBccEra
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 SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath ByteString
jsonOutput
Maybe OutputFile
Nothing -> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn ByteString
jsonOutput
ConsensusMode mode
mode -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (AnyConsensusMode -> SophieQueryCmdError
SophieQueryCmdUnsupportedMode (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode))
runQueryUTxO
:: AnyConsensusModeParams
-> QueryUTxOFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryUTxO :: AnyConsensusModeParams
-> QueryUTxOFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryUTxO (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
QueryUTxOFilter
qfilter NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr 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 :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
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
SophieBasedEra era
sbe <- BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall (m :: * -> *) era.
Monad m =>
BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe (BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era))
-> BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall a b. (a -> b) -> a -> b
$ BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era
case BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra era
era ConsensusMode mode
cMode of
Just EraInMode era mode
eInMode -> do
let query :: QueryInEra era (UTxO era)
query = SophieBasedEra era
-> QueryInSophieBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe (QueryUTxOFilter -> QueryInSophieBasedEra era (UTxO era)
forall era. QueryUTxOFilter -> QueryInSophieBasedEra 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 <- BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (UTxO era))
-> ExceptT SophieQueryCmdError IO (UTxO era)
forall result era mode.
BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery
BccEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode mode (Either EraMismatch (UTxO era))
qInMode
SophieBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT SophieQueryCmdError IO ()
forall era.
SophieBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT SophieQueryCmdError IO ()
writeFilteredUTxOs SophieBasedEra era
sbe Maybe OutputFile
mOutFile UTxO era
result
Maybe (EraInMode era mode)
Nothing -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
anyE
runQueryPoolParams
:: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT SophieQueryCmdError IO ()
runQueryPoolParams :: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT SophieQueryCmdError IO ()
runQueryPoolParams (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Hash StakePoolKey
poolid = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr 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 :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
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
SophieBasedEra era
sbe <- BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall (m :: * -> *) era.
Monad m =>
BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe (BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era))
-> BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall a b. (a -> b) -> a -> b
$ BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era
EraInMode era mode
eInMode <- BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra era
era ConsensusMode mode
cMode
Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
-> ExceptT SophieQueryCmdError IO (EraInMode era mode))
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
forall a b. a -> (a -> b) -> b
& SophieQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
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)))
-> (QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInSophieBasedEra 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
. SophieBasedEra era
-> QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe (QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
SerialisedDebugLedgerState era
result <- BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT SophieQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery BccEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
SophieBasedEra era
-> ((SophieBased (SophieLedgerEra era),
ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
Crypto (SophieLedgerEra era) ~ StandardCrypto) =>
SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
forall era ledgerera a.
(SophieLedgerEra era ~ ledgerera) =>
SophieBasedEra era
-> ((SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a)
-> a
obtainLedgerEraClassConstraints SophieBasedEra era
sbe (Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera, FromCBOR (DebugLedgerState era),
Crypto (Crypto ledgerera), Crypto ledgerera ~ StandardCrypto) =>
Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
writePoolParams Hash StakePoolKey
poolid) SerialisedDebugLedgerState era
result
runQueryStakeSnapshot
:: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT SophieQueryCmdError IO ()
runQueryStakeSnapshot :: AnyConsensusModeParams
-> NetworkId
-> Hash StakePoolKey
-> ExceptT SophieQueryCmdError IO ()
runQueryStakeSnapshot (AnyConsensusModeParams ConsensusModeParams mode
cModeParams) NetworkId
network Hash StakePoolKey
poolid = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr 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 :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
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
SophieBasedEra era
sbe <- BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall (m :: * -> *) era.
Monad m =>
BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe (BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era))
-> BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall a b. (a -> b) -> a -> b
$ BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era
EraInMode era mode
eInMode <- BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra era
era ConsensusMode mode
cMode
Maybe (EraInMode era mode)
-> (Maybe (EraInMode era mode)
-> ExceptT SophieQueryCmdError IO (EraInMode era mode))
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
forall a b. a -> (a -> b) -> b
& SophieQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
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)))
-> (QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInSophieBasedEra 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
. SophieBasedEra era
-> QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe (QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
SerialisedDebugLedgerState era
result <- BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT SophieQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery BccEra era
era ConsensusModeParams mode
cModeParams LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
SophieBasedEra era
-> ((SophieBased (SophieLedgerEra era),
ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
Crypto (SophieLedgerEra era) ~ StandardCrypto) =>
SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
forall era ledgerera a.
(SophieLedgerEra era ~ ledgerera) =>
SophieBasedEra era
-> ((SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a)
-> a
obtainLedgerEraClassConstraints SophieBasedEra era
sbe (Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
Crypto ledgerera ~ StandardCrypto,
FromCBOR (DebugLedgerState era)) =>
Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
writeStakeSnapshot Hash StakePoolKey
poolid) SerialisedDebugLedgerState era
result
runQueryLedgerState
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryLedgerState :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryLedgerState (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr 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 :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
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
SophieBasedEra era
sbe <- BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall (m :: * -> *) era.
Monad m =>
BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe (BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era))
-> BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall a b. (a -> b) -> a -> b
$ BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era
case BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra 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)))
-> (QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era))
-> QueryInSophieBasedEra 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
. SophieBasedEra era
-> QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInEra era (SerialisedDebugLedgerState era)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe
(QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era)))
-> QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
forall a b. (a -> b) -> a -> b
$ QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
forall era.
QueryInSophieBasedEra era (SerialisedDebugLedgerState era)
QueryDebugLedgerState
SerialisedDebugLedgerState era
result <- BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
-> ExceptT SophieQueryCmdError IO (SerialisedDebugLedgerState era)
forall result era mode.
BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery
BccEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode
mode (Either EraMismatch (SerialisedDebugLedgerState era))
qInMode
SophieBasedEra era
-> ((SophieBased (SophieLedgerEra era),
ToJSON (DebugLedgerState era), FromCBOR (DebugLedgerState era),
Crypto (SophieLedgerEra era) ~ StandardCrypto) =>
SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ())
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
forall era ledgerera a.
(SophieLedgerEra era ~ ledgerera) =>
SophieBasedEra era
-> ((SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a)
-> a
obtainLedgerEraClassConstraints SophieBasedEra era
sbe (Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era)) =>
Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
writeLedgerState Maybe OutputFile
mOutFile) SerialisedDebugLedgerState era
result
Maybe (EraInMode era mode)
Nothing -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
anyE
runQueryProtocolState
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryProtocolState :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryProtocolState (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr 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 :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
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
SophieBasedEra era
sbe <- BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall (m :: * -> *) era.
Monad m =>
BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe (BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era))
-> BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall a b. (a -> b) -> a -> b
$ BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era
case BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra 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)))
-> (QueryInSophieBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era))
-> QueryInSophieBasedEra 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
. SophieBasedEra era
-> QueryInSophieBasedEra era (ProtocolState era)
-> QueryInEra era (ProtocolState era)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe
(QueryInSophieBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era)))
-> QueryInSophieBasedEra era (ProtocolState era)
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
forall a b. (a -> b) -> a -> b
$ QueryInSophieBasedEra era (ProtocolState era)
forall era. QueryInSophieBasedEra era (ProtocolState era)
QueryProtocolState
ProtocolState era
result <- BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch (ProtocolState era))
-> ExceptT SophieQueryCmdError IO (ProtocolState era)
forall result era mode.
BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery
BccEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode mode (Either EraMismatch (ProtocolState era))
qInMode
Maybe OutputFile
-> ProtocolState era -> ExceptT SophieQueryCmdError IO ()
forall era.
Crypto StandardCrypto =>
Maybe OutputFile
-> ProtocolState era -> ExceptT SophieQueryCmdError IO ()
writeProtocolState Maybe OutputFile
mOutFile ProtocolState era
result
Maybe (EraInMode era mode)
Nothing -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
anyE
runQueryStakeAddressInfo
:: AnyConsensusModeParams
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryStakeAddressInfo :: AnyConsensusModeParams
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryStakeAddressInfo (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
(StakeAddress Network
_ StakeCredential StandardCrypto
addr) NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr 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 :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
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
SophieBasedEra era
sbe <- BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall (m :: * -> *) era.
Monad m =>
BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe (BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era))
-> BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall a b. (a -> b) -> a -> b
$ BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era
case BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra 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
fromSophieStakeCredential StakeCredential StandardCrypto
addr
query :: QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey)))
query = EraInMode era mode
-> QueryInEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Entropic, 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 Entropic, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))))
-> (QueryInSophieBasedEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
-> QueryInEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey)))
-> QueryInSophieBasedEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Entropic, 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
. SophieBasedEra era
-> QueryInSophieBasedEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
-> QueryInEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe
(QueryInSophieBasedEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))))
-> QueryInSophieBasedEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey)))
forall a b. (a -> b) -> a -> b
$ Set StakeCredential
-> NetworkId
-> QueryInSophieBasedEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
forall era.
Set StakeCredential
-> NetworkId
-> QueryInSophieBasedEra
era
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
QueryStakeAddresses Set StakeCredential
stakeAddr NetworkId
network
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
result <- BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey)))
-> ExceptT
SophieQueryCmdError
IO
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
forall result era mode.
BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery
BccEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode
mode
(Either
EraMismatch
(Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey)))
query
Maybe OutputFile
-> DelegationsAndRewards -> ExceptT SophieQueryCmdError IO ()
writeStakeAddressInfo Maybe OutputFile
mOutFile (DelegationsAndRewards -> ExceptT SophieQueryCmdError IO ())
-> DelegationsAndRewards -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ (Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
-> DelegationsAndRewards
DelegationsAndRewards (Map StakeAddress Entropic, Map StakeAddress (Hash StakePoolKey))
result
Maybe (EraInMode era mode)
Nothing -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
anyE
data SophieQueryCmdLocalStateQueryError
= AcquireFailureError !LocalStateQuery.AcquireFailure
| EraMismatchError !EraMismatch
| ColeProtocolNotSupportedError
| SophieProtocolEraMismatch
deriving (SophieQueryCmdLocalStateQueryError
-> SophieQueryCmdLocalStateQueryError -> Bool
(SophieQueryCmdLocalStateQueryError
-> SophieQueryCmdLocalStateQueryError -> Bool)
-> (SophieQueryCmdLocalStateQueryError
-> SophieQueryCmdLocalStateQueryError -> Bool)
-> Eq SophieQueryCmdLocalStateQueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SophieQueryCmdLocalStateQueryError
-> SophieQueryCmdLocalStateQueryError -> Bool
$c/= :: SophieQueryCmdLocalStateQueryError
-> SophieQueryCmdLocalStateQueryError -> Bool
== :: SophieQueryCmdLocalStateQueryError
-> SophieQueryCmdLocalStateQueryError -> Bool
$c== :: SophieQueryCmdLocalStateQueryError
-> SophieQueryCmdLocalStateQueryError -> Bool
Eq, Int -> SophieQueryCmdLocalStateQueryError -> ShowS
[SophieQueryCmdLocalStateQueryError] -> ShowS
SophieQueryCmdLocalStateQueryError -> String
(Int -> SophieQueryCmdLocalStateQueryError -> ShowS)
-> (SophieQueryCmdLocalStateQueryError -> String)
-> ([SophieQueryCmdLocalStateQueryError] -> ShowS)
-> Show SophieQueryCmdLocalStateQueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SophieQueryCmdLocalStateQueryError] -> ShowS
$cshowList :: [SophieQueryCmdLocalStateQueryError] -> ShowS
show :: SophieQueryCmdLocalStateQueryError -> String
$cshow :: SophieQueryCmdLocalStateQueryError -> String
showsPrec :: Int -> SophieQueryCmdLocalStateQueryError -> ShowS
$cshowsPrec :: Int -> SophieQueryCmdLocalStateQueryError -> ShowS
Show)
renderLocalStateQueryError :: SophieQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError :: SophieQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError SophieQueryCmdLocalStateQueryError
lsqErr =
case SophieQueryCmdLocalStateQueryError
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
SophieQueryCmdLocalStateQueryError
ColeProtocolNotSupportedError ->
Text
"The attempted local state query does not support the Cole protocol."
SophieQueryCmdLocalStateQueryError
SophieProtocolEraMismatch ->
Text
"The Sophie protocol mode can only be used with the Sophie era, "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"i.e. with --sophie-mode use --sophie-era flag"
writeStakeAddressInfo
:: Maybe OutputFile
-> DelegationsAndRewards
-> ExceptT SophieQueryCmdError IO ()
writeStakeAddressInfo :: Maybe OutputFile
-> DelegationsAndRewards -> ExceptT SophieQueryCmdError IO ()
writeStakeAddressInfo Maybe OutputFile
mOutFile DelegationsAndRewards
delegsAndRewards =
case Maybe OutputFile
mOutFile of
Maybe OutputFile
Nothing -> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError 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 -> SophieQueryCmdError)
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieQueryCmdError
SophieQueryCmdWriteFileError (FileError () -> SophieQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieQueryCmdError
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 SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError 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.
SophieLedgerEra era ~ ledgerera
=> ToJSON (DebugLedgerState era)
=> FromCBOR (DebugLedgerState era)
=> Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
writeLedgerState :: Maybe OutputFile
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
writeLedgerState Maybe OutputFile
mOutFile qState :: SerialisedDebugLedgerState era
qState@(SerialisedDebugLedgerState Serialised (NewEpochState (SophieLedgerEra 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 -> SophieQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> SophieQueryCmdError
SophieQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
Right DebugLedgerState era
ledgerState -> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ())
-> ByteString -> ExceptT SophieQueryCmdError 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 -> SophieQueryCmdError)
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieQueryCmdError
SophieQueryCmdWriteFileError (FileError () -> SophieQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieQueryCmdError
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 SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError 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 (SophieLedgerEra era))
serLedgerState
writeStakeSnapshot :: forall era ledgerera. ()
=> SophieLedgerEra era ~ ledgerera
=> Era.Crypto ledgerera ~ StandardCrypto
=> FromCBOR (DebugLedgerState era)
=> PoolId
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
writeStakeSnapshot :: Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError 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
Left ByteString
bs -> (HelpersError -> SophieQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> SophieQueryCmdError
SophieQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
Right DebugLedgerState era
ledgerState -> do
let (DebugLedgerState NewEpochState ledgerera
snapshot) = DebugLedgerState era
ledgerState
let (SnapShots SnapShot StandardCrypto
markS SnapShot StandardCrypto
setS SnapShot StandardCrypto
goS Coin
_) = EpochState ledgerera -> SnapShots (Crypto ledgerera)
forall era. EpochState era -> SnapShots (Crypto era)
esSnapshots (EpochState ledgerera -> SnapShots (Crypto ledgerera))
-> EpochState ledgerera -> SnapShots (Crypto ledgerera)
forall a b. (a -> b) -> a -> b
$ NewEpochState ledgerera -> EpochState ledgerera
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState ledgerera
snapshot
IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ())
-> ByteString -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Stakes -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Stakes -> ByteString) -> Stakes -> ByteString
forall a b. (a -> b) -> a -> b
$ Stakes :: Integer
-> Integer -> Integer -> Integer -> Integer -> Integer -> Stakes
Stakes
{ markPool :: Integer
markPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
markS
, setPool :: Integer
setPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
setS
, goPool :: Integer
goPool = KeyHash 'StakePool StandardCrypto
-> SnapShot StandardCrypto -> Integer
forall crypto.
KeyHash 'StakePool crypto -> SnapShot crypto -> Integer
getPoolStake KeyHash 'StakePool StandardCrypto
hk SnapShot StandardCrypto
goS
, markTotal :: Integer
markTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
markS
, setTotal :: Integer
setTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
setS
, goTotal :: Integer
goTotal = SnapShot StandardCrypto -> Integer
forall crypto. SnapShot crypto -> Integer
getAllStake SnapShot StandardCrypto
goS
}
getPoolStake :: KeyHash Bcc.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)
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
writePoolParams :: forall era ledgerera. ()
=> SophieLedgerEra era ~ ledgerera
=> FromCBOR (DebugLedgerState era)
=> Crypto.Crypto (Era.Crypto ledgerera)
=> Era.Crypto ledgerera ~ StandardCrypto
=> PoolId
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError IO ()
writePoolParams :: Hash StakePoolKey
-> SerialisedDebugLedgerState era
-> ExceptT SophieQueryCmdError 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
Left ByteString
bs -> (HelpersError -> SophieQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> SophieQueryCmdError
SophieQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError 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
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 SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ())
-> ByteString -> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ()
writeProtocolState :: Maybe OutputFile
-> ProtocolState era -> ExceptT SophieQueryCmdError IO ()
writeProtocolState Maybe OutputFile
mOutFile ps :: ProtocolState era
ps@(ProtocolState Serialised (ChainDepState (Crypto (SophieLedgerEra 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 -> SophieQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> SophieQueryCmdError
SophieQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs
Right ChainDepState StandardCrypto
chainDepstate -> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ())
-> ByteString -> ExceptT SophieQueryCmdError 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 -> SophieQueryCmdError)
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieQueryCmdError
SophieQueryCmdWriteFileError (FileError () -> SophieQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieQueryCmdError
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 SophieQueryCmdError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ())
-> ByteString -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Serialised (ChainDepState (Crypto (SophieLedgerEra era)))
-> ByteString
forall a. Serialised a -> ByteString
unSerialised Serialised (ChainDepState (Crypto (SophieLedgerEra 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 :: SophieBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT SophieQueryCmdError IO ()
writeFilteredUTxOs :: SophieBasedEra era
-> Maybe OutputFile
-> UTxO era
-> ExceptT SophieQueryCmdError IO ()
writeFilteredUTxOs SophieBasedEra era
sophieBasedEra' Maybe OutputFile
mOutFile UTxO era
utxo =
case Maybe OutputFile
mOutFile of
Maybe OutputFile
Nothing -> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SophieBasedEra era -> UTxO era -> IO ()
forall era. SophieBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs SophieBasedEra era
sophieBasedEra' UTxO era
utxo
Just (OutputFile String
fpath) ->
case SophieBasedEra era
sophieBasedEra' of
SophieBasedEra era
SophieBasedEraSophie -> String -> UTxO era -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT SophieQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
SophieBasedEra era
SophieBasedEraEvie -> String -> UTxO era -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT SophieQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
SophieBasedEra era
SophieBasedEraJen -> String -> UTxO era -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT SophieQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
SophieBasedEra era
SophieBasedEraAurum -> String -> UTxO era -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
String -> a -> ExceptT SophieQueryCmdError m ()
writeUTxo String
fpath UTxO era
utxo
where
writeUTxo :: String -> a -> ExceptT SophieQueryCmdError m ()
writeUTxo String
fpath a
utxo' =
(IOException -> SophieQueryCmdError)
-> IO () -> ExceptT SophieQueryCmdError m ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieQueryCmdError
SophieQueryCmdWriteFileError (FileError () -> SophieQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieQueryCmdError
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 SophieQueryCmdError m ())
-> IO () -> ExceptT SophieQueryCmdError 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 :: SophieBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs :: SophieBasedEra era -> UTxO era -> IO ()
printFilteredUTxOs SophieBasedEra era
sophieBasedEra' (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 SophieBasedEra era
sophieBasedEra' of
SophieBasedEra era
SophieBasedEraSophie ->
((TxIn, TxOut era) -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
forall era. SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo SophieBasedEra era
sophieBasedEra') ([(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
SophieBasedEra era
SophieBasedEraEvie ->
((TxIn, TxOut era) -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
forall era. SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo SophieBasedEra era
sophieBasedEra') ([(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
SophieBasedEra era
SophieBasedEraJen ->
((TxIn, TxOut era) -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
forall era. SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo SophieBasedEra era
sophieBasedEra') ([(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
SophieBasedEra era
SophieBasedEraAurum ->
((TxIn, TxOut era) -> IO ()) -> [(TxIn, TxOut era)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
forall era. SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo SophieBasedEra era
sophieBasedEra') ([(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
:: SophieBasedEra era
-> (TxIn, TxOut era)
-> IO ()
printUtxo :: SophieBasedEra era -> (TxIn, TxOut era) -> IO ()
printUtxo SophieBasedEra era
sophieBasedEra' (TxIn, TxOut era)
txInOutTuple =
case SophieBasedEra era
sophieBasedEra' of
SophieBasedEra era
SophieBasedEraSophie ->
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
]
SophieBasedEra era
SophieBasedEraEvie ->
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
]
SophieBasedEra era
SophieBasedEraJen ->
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
]
SophieBasedEra era
SophieBasedEraAurum ->
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 (TxOutBccOnly OnlyBccSupportedInEra era
_ (Entropic Integer
i)) = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Integer
i
runQueryStakePools
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryStakePools :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryStakePools (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
let localNodeConnInfo :: LocalNodeConnectInfo mode
localNodeConnInfo = ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams mode
cModeParams NetworkId
network String
sockPath
Set (Hash StakePoolKey)
result <- IO (Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> ExceptT SophieQueryCmdError IO (Set (Hash StakePoolKey))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> ExceptT SophieQueryCmdError IO (Set (Hash StakePoolKey)))
-> (IO
(Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> IO (Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> IO
(Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> ExceptT SophieQueryCmdError IO (Set (Hash StakePoolKey))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> IO
(Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> IO (Either SophieQueryCmdError (Set (Hash StakePoolKey)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either
SophieQueryCmdError
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> Either SophieQueryCmdError (Set (Hash StakePoolKey))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either
SophieQueryCmdError
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> (Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> Either
SophieQueryCmdError
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> Either SophieQueryCmdError (Set (Hash StakePoolKey))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (AcquireFailure -> SophieQueryCmdError)
-> Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))
-> Either
SophieQueryCmdError
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AcquireFailure -> SophieQueryCmdError
SophieQueryCmdAcquireFailure) (IO
(Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> ExceptT SophieQueryCmdError IO (Set (Hash StakePoolKey)))
-> IO
(Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> ExceptT SophieQueryCmdError IO (Set (Hash StakePoolKey))
forall a b. (a -> b) -> a -> b
$
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> IO
(Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
forall mode a.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (Either AcquireFailure a)
executeLocalStateQueryExpr LocalNodeConnectInfo mode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing ((NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> IO
(Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))))
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> IO
(Either
AcquireFailure
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
_ntcVersion -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
forall (m :: * -> *) a.
ExceptT SophieQueryCmdError m a -> m (Either SophieQueryCmdError a)
runExceptT @SophieQueryCmdError (ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError (Set (Hash StakePoolKey))))
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either SophieQueryCmdError (Set (Hash StakePoolKey)))
forall a b. (a -> b) -> a -> b
$ do
anyE :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- case ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams of
ConsensusMode mode
ColeMode -> AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra)
-> AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra
forall a b. (a -> b) -> a -> b
$ BccEra ColeEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra ColeEra
ColeEra
ConsensusMode mode
SophieMode -> AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra)
-> AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra
forall a b. (a -> b) -> a -> b
$ BccEra SophieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra SophieEra
SophieEra
ConsensusMode mode
BccMode -> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
AnyBccEra
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
AnyBccEra)
-> (QueryInMode BccMode AnyBccEra
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
AnyBccEra)
-> QueryInMode BccMode AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode BccMode) ChainPoint (QueryInMode BccMode) () IO)
AnyBccEra
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryInMode BccMode AnyBccEra
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
AnyBccEra
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode BccMode AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra)
-> QueryInMode BccMode AnyBccEra
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
AnyBccEra
forall a b. (a -> b) -> a -> b
$ ConsensusModeIsMultiEra BccMode -> QueryInMode BccMode AnyBccEra
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode AnyBccEra
QueryCurrentEra ConsensusModeIsMultiEra BccMode
BccModeIsMultiEra
let cMode :: ConsensusMode mode
cMode = ConsensusModeParams mode -> ConsensusMode mode
forall mode. ConsensusModeParams mode -> ConsensusMode mode
consensusModeOnly ConsensusModeParams mode
cModeParams
case BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra era
era ConsensusMode mode
cMode of
Just EraInMode era mode
eInMode -> do
SophieBasedEra era
sbe <- BccEraStyle era
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(SophieBasedEra era)
forall (m :: * -> *) era.
Monad m =>
BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe (BccEraStyle era
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(SophieBasedEra era))
-> BccEraStyle era
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(SophieBasedEra era)
forall a b. (a -> b) -> a -> b
$ BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era
(EraMismatch -> SophieQueryCmdError)
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EraMismatch -> SophieQueryCmdError
SophieQueryCmdEraMismatch (ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey)))
-> (LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey)))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
EraMismatch
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey)))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall a b. (a -> b) -> a -> b
$
QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey)))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey)))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey))))
-> (QueryInSophieBasedEra era (Set (Hash StakePoolKey))
-> QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey))))
-> QueryInSophieBasedEra era (Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EraInMode era mode
-> QueryInEra era (Set (Hash StakePoolKey))
-> QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey)))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era mode
eInMode (QueryInEra era (Set (Hash StakePoolKey))
-> QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey))))
-> (QueryInSophieBasedEra era (Set (Hash StakePoolKey))
-> QueryInEra era (Set (Hash StakePoolKey)))
-> QueryInSophieBasedEra era (Set (Hash StakePoolKey))
-> QueryInMode mode (Either EraMismatch (Set (Hash StakePoolKey)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SophieBasedEra era
-> QueryInSophieBasedEra era (Set (Hash StakePoolKey))
-> QueryInEra era (Set (Hash StakePoolKey))
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe (QueryInSophieBasedEra era (Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey))))
-> QueryInSophieBasedEra era (Set (Hash StakePoolKey))
-> LocalStateQueryExpr
(BlockInMode mode)
ChainPoint
(QueryInMode mode)
()
IO
(Either EraMismatch (Set (Hash StakePoolKey)))
forall a b. (a -> b) -> a -> b
$ QueryInSophieBasedEra era (Set (Hash StakePoolKey))
forall era. QueryInSophieBasedEra era (Set (Hash StakePoolKey))
QueryStakePools
Maybe (EraInMode era mode)
Nothing -> SophieQueryCmdError
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey)))
-> SophieQueryCmdError
-> ExceptT
SophieQueryCmdError
(LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO)
(Set (Hash StakePoolKey))
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
anyE
Maybe OutputFile
-> Set (Hash StakePoolKey) -> ExceptT SophieQueryCmdError IO ()
writeStakePools Maybe OutputFile
mOutFile Set (Hash StakePoolKey)
result
writeStakePools
:: Maybe OutputFile
-> Set PoolId
-> ExceptT SophieQueryCmdError IO ()
writeStakePools :: Maybe OutputFile
-> Set (Hash StakePoolKey) -> ExceptT SophieQueryCmdError IO ()
writeStakePools (Just (OutputFile String
outFile)) Set (Hash StakePoolKey)
stakePools =
(IOException -> SophieQueryCmdError)
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieQueryCmdError
SophieQueryCmdWriteFileError (FileError () -> SophieQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieQueryCmdError
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 SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
String -> ByteString -> IO ()
LBS.writeFile String
outFile (Set (Hash StakePoolKey) -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Set (Hash StakePoolKey)
stakePools)
writeStakePools Maybe OutputFile
Nothing Set (Hash StakePoolKey)
stakePools =
[Hash StakePoolKey]
-> (Hash StakePoolKey -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Set (Hash StakePoolKey) -> [Hash StakePoolKey]
forall a. Set a -> [a]
Set.toList Set (Hash StakePoolKey)
stakePools) ((Hash StakePoolKey -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO ())
-> (Hash StakePoolKey -> ExceptT SophieQueryCmdError IO ())
-> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \Hash StakePoolKey
poolId ->
IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> (String -> IO ()) -> String -> ExceptT SophieQueryCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> ExceptT SophieQueryCmdError IO ())
-> String -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Hash StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Hash StakePoolKey
poolId)
runQueryStakeDistribution
:: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryStakeDistribution :: AnyConsensusModeParams
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieQueryCmdError IO ()
runQueryStakeDistribution (AnyConsensusModeParams ConsensusModeParams mode
cModeParams)
NetworkId
network Maybe OutputFile
mOutFile = do
SocketPath String
sockPath <- (EnvSocketError -> SophieQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT SophieQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> SophieQueryCmdError
SophieQueryCmdEnvVarSocketErr 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 :: AnyBccEra
anyE@(AnyBccEra BccEra era
era) <- ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
forall mode.
ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
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
SophieBasedEra era
sbe <- BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall (m :: * -> *) era.
Monad m =>
BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe (BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era))
-> BccEraStyle era
-> ExceptT SophieQueryCmdError IO (SophieBasedEra era)
forall a b. (a -> b) -> a -> b
$ BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle BccEra era
era
case BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra 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)))
-> (QueryInSophieBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInEra era (Map (Hash StakePoolKey) Rational))
-> QueryInSophieBasedEra 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
. SophieBasedEra era
-> QueryInSophieBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInEra era (Map (Hash StakePoolKey) Rational)
forall era result.
SophieBasedEra era
-> QueryInSophieBasedEra era result -> QueryInEra era result
QueryInSophieBasedEra SophieBasedEra era
sbe
(QueryInSophieBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational)))
-> QueryInSophieBasedEra era (Map (Hash StakePoolKey) Rational)
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
forall a b. (a -> b) -> a -> b
$ QueryInSophieBasedEra era (Map (Hash StakePoolKey) Rational)
forall era.
QueryInSophieBasedEra era (Map (Hash StakePoolKey) Rational)
QueryStakeDistribution
Map (Hash StakePoolKey) Rational
result <- BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
-> ExceptT
SophieQueryCmdError IO (Map (Hash StakePoolKey) Rational)
forall result era mode.
BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery
BccEra era
era
ConsensusModeParams mode
cModeParams
LocalNodeConnectInfo mode
localNodeConnInfo
QueryInMode
mode (Either EraMismatch (Map (Hash StakePoolKey) Rational))
query
Maybe OutputFile
-> Map (Hash StakePoolKey) Rational
-> ExceptT SophieQueryCmdError IO ()
writeStakeDistribution Maybe OutputFile
mOutFile Map (Hash StakePoolKey) Rational
result
Maybe (EraInMode era mode)
Nothing -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ())
-> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
cMode) AnyBccEra
anyE
writeStakeDistribution
:: Maybe OutputFile
-> Map PoolId Rational
-> ExceptT SophieQueryCmdError IO ()
writeStakeDistribution :: Maybe OutputFile
-> Map (Hash StakePoolKey) Rational
-> ExceptT SophieQueryCmdError IO ()
writeStakeDistribution (Just (OutputFile String
outFile)) Map (Hash StakePoolKey) Rational
stakeDistrib =
(IOException -> SophieQueryCmdError)
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieQueryCmdError
SophieQueryCmdWriteFileError (FileError () -> SophieQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieQueryCmdError
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 SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError 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 SophieQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieQueryCmdError IO ())
-> IO () -> ExceptT SophieQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Map (Hash StakePoolKey) Rational -> IO ()
printStakeDistribution Map (Hash StakePoolKey) Rational
stakeDistrib
printStakeDistribution :: Map PoolId Rational -> IO ()
printStakeDistribution :: Map (Hash StakePoolKey) Rational -> IO ()
printStakeDistribution Map (Hash StakePoolKey) Rational
stakeDistrib = do
Text -> IO ()
Text.putStrLn Text
title
String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Text -> Int
Text.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
'-'
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Hash StakePoolKey -> Rational -> String
showStakeDistr Hash StakePoolKey
poolId Rational
stakeFraction
| (Hash StakePoolKey
poolId, Rational
stakeFraction) <- Map (Hash StakePoolKey) Rational -> [(Hash StakePoolKey, Rational)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Hash StakePoolKey) Rational
stakeDistrib ]
where
title :: Text
title :: Text
title =
Text
" PoolId Stake frac"
showStakeDistr :: PoolId
-> Rational
-> String
showStakeDistr :: Hash StakePoolKey -> Rational -> String
showStakeDistr Hash StakePoolKey
poolId Rational
stakeFraction =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ Text -> String
Text.unpack (Hash StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Hash StakePoolKey
poolId)
, String
" "
, Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
stakeFraction :: Double) String
""
]
newtype DelegationsAndRewards
= DelegationsAndRewards (Map StakeAddress Entropic, Map StakeAddress PoolId)
mergeDelegsAndRewards :: DelegationsAndRewards -> [(StakeAddress, Maybe Entropic, Maybe PoolId)]
mergeDelegsAndRewards :: DelegationsAndRewards
-> [(StakeAddress, Maybe Entropic, Maybe (Hash StakePoolKey))]
mergeDelegsAndRewards (DelegationsAndRewards (Map StakeAddress Entropic
rewardsMap, Map StakeAddress (Hash StakePoolKey)
delegMap)) =
[ (StakeAddress
stakeAddr, StakeAddress -> Map StakeAddress Entropic -> Maybe Entropic
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeAddress
stakeAddr Map StakeAddress Entropic
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 Entropic -> [StakeAddress]
forall k a. Map k a -> [k]
Map.keys Map StakeAddress Entropic
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 Entropic, Maybe (Hash StakePoolKey))]
-> Array)
-> [(StakeAddress, Maybe Entropic, 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 Entropic, Maybe (Hash StakePoolKey))]
-> [Value])
-> [(StakeAddress, Maybe Entropic, 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 Entropic, Maybe (Hash StakePoolKey))
-> Value)
-> [(StakeAddress, Maybe Entropic, Maybe (Hash StakePoolKey))]
-> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (StakeAddress, Maybe Entropic, Maybe (Hash StakePoolKey)) -> Value
delegAndRwdToJson ([(StakeAddress, Maybe Entropic, Maybe (Hash StakePoolKey))]
-> Value)
-> [(StakeAddress, Maybe Entropic, Maybe (Hash StakePoolKey))]
-> Value
forall a b. (a -> b) -> a -> b
$ DelegationsAndRewards
-> [(StakeAddress, Maybe Entropic, Maybe (Hash StakePoolKey))]
mergeDelegsAndRewards DelegationsAndRewards
delegsAndRwds
where
delegAndRwdToJson :: (StakeAddress, Maybe Entropic, Maybe PoolId) -> Aeson.Value
delegAndRwdToJson :: (StakeAddress, Maybe Entropic, Maybe (Hash StakePoolKey)) -> Value
delegAndRwdToJson (StakeAddress
addr, Maybe Entropic
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 Entropic -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Entropic
mRewards
]
calcEraInMode
:: BccEra era
-> ConsensusMode mode
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
calcEraInMode :: BccEra era
-> ConsensusMode mode
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
calcEraInMode BccEra era
era ConsensusMode mode
mode=
SophieQueryCmdError
-> Maybe (EraInMode era mode)
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyConsensusMode -> AnyBccEra -> SophieQueryCmdError
SophieQueryCmdEraConsensusModeMismatch (ConsensusMode mode -> AnyConsensusMode
forall mode. ConsensusMode mode -> AnyConsensusMode
AnyConsensusMode ConsensusMode mode
mode) (BccEra era -> AnyBccEra
forall era. BccEra era -> AnyBccEra
anyBccEra BccEra era
era))
(Maybe (EraInMode era mode)
-> ExceptT SophieQueryCmdError IO (EraInMode era mode))
-> Maybe (EraInMode era mode)
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
forall a b. (a -> b) -> a -> b
$ BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
forall era mode.
BccEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode BccEra era
era ConsensusMode mode
mode
determineEra
:: ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
determineEra :: ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> ExceptT SophieQueryCmdError IO AnyBccEra
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
ColeMode -> AnyBccEra -> ExceptT SophieQueryCmdError IO AnyBccEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyBccEra -> ExceptT SophieQueryCmdError IO AnyBccEra)
-> AnyBccEra -> ExceptT SophieQueryCmdError IO AnyBccEra
forall a b. (a -> b) -> a -> b
$ BccEra ColeEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra ColeEra
ColeEra
ConsensusMode mode
SophieMode -> AnyBccEra -> ExceptT SophieQueryCmdError IO AnyBccEra
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyBccEra -> ExceptT SophieQueryCmdError IO AnyBccEra)
-> AnyBccEra -> ExceptT SophieQueryCmdError IO AnyBccEra
forall a b. (a -> b) -> a -> b
$ BccEra SophieEra -> AnyBccEra
forall era. IsBccEra era => BccEra era -> AnyBccEra
AnyBccEra BccEra SophieEra
SophieEra
ConsensusMode mode
BccMode -> do
Either AcquireFailure AnyBccEra
eraQ <- IO (Either AcquireFailure AnyBccEra)
-> ExceptT SophieQueryCmdError IO (Either AcquireFailure AnyBccEra)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either AcquireFailure AnyBccEra)
-> ExceptT
SophieQueryCmdError IO (Either AcquireFailure AnyBccEra))
-> (QueryInMode BccMode AnyBccEra
-> IO (Either AcquireFailure AnyBccEra))
-> QueryInMode BccMode AnyBccEra
-> ExceptT SophieQueryCmdError IO (Either AcquireFailure AnyBccEra)
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 AnyBccEra
-> IO (Either AcquireFailure AnyBccEra)
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 BccMode AnyBccEra
-> ExceptT
SophieQueryCmdError IO (Either AcquireFailure AnyBccEra))
-> QueryInMode BccMode AnyBccEra
-> ExceptT SophieQueryCmdError IO (Either AcquireFailure AnyBccEra)
forall a b. (a -> b) -> a -> b
$ ConsensusModeIsMultiEra BccMode -> QueryInMode BccMode AnyBccEra
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode AnyBccEra
QueryCurrentEra ConsensusModeIsMultiEra BccMode
BccModeIsMultiEra
case Either AcquireFailure AnyBccEra
eraQ of
Left AcquireFailure
acqFail -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO AnyBccEra
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO AnyBccEra)
-> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO AnyBccEra
forall a b. (a -> b) -> a -> b
$ AcquireFailure -> SophieQueryCmdError
SophieQueryCmdAcquireFailure AcquireFailure
acqFail
Right AnyBccEra
anyCarEra -> AnyBccEra -> ExceptT SophieQueryCmdError IO AnyBccEra
forall (m :: * -> *) a. Monad m => a -> m a
return AnyBccEra
anyCarEra
executeQuery
:: forall result era mode. BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery :: BccEra era
-> ConsensusModeParams mode
-> LocalNodeConnectInfo mode
-> QueryInMode mode (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
executeQuery BccEra era
era ConsensusModeParams mode
cModeP LocalNodeConnectInfo mode
localNodeConnInfo QueryInMode mode (Either EraMismatch result)
q = do
EraInMode era mode
eraInMode <- BccEra era
-> ConsensusMode mode
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
forall era mode.
BccEra era
-> ConsensusMode mode
-> ExceptT SophieQueryCmdError IO (EraInMode era mode)
calcEraInMode BccEra era
era (ConsensusMode mode
-> ExceptT SophieQueryCmdError IO (EraInMode era mode))
-> ConsensusMode mode
-> ExceptT SophieQueryCmdError 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
ColeEraInColeMode -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO result
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left SophieQueryCmdError
SophieQueryCmdColeEra
EraInMode era mode
_ -> IO (Either AcquireFailure (Either EraMismatch result))
-> ExceptT
SophieQueryCmdError
IO
(Either AcquireFailure (Either EraMismatch result))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either AcquireFailure (Either EraMismatch result))
execQuery ExceptT
SophieQueryCmdError
IO
(Either AcquireFailure (Either EraMismatch result))
-> (Either AcquireFailure (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result)
-> ExceptT SophieQueryCmdError IO result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either AcquireFailure (Either EraMismatch result)
-> ExceptT SophieQueryCmdError IO result
forall a.
Either AcquireFailure (Either EraMismatch a)
-> ExceptT SophieQueryCmdError 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 :: Monad m => BccEraStyle era -> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe :: BccEraStyle era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
getSbe BccEraStyle era
LegacyColeEra = SophieQueryCmdError
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left SophieQueryCmdError
SophieQueryCmdColeEra
getSbe (SophieBasedEra SophieBasedEra era
sbe) = SophieBasedEra era
-> ExceptT SophieQueryCmdError m (SophieBasedEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return SophieBasedEra era
sbe
queryResult
:: Either AcquireFailure (Either EraMismatch a)
-> ExceptT SophieQueryCmdError IO a
queryResult :: Either AcquireFailure (Either EraMismatch a)
-> ExceptT SophieQueryCmdError IO a
queryResult Either AcquireFailure (Either EraMismatch a)
eAcq =
case Either AcquireFailure (Either EraMismatch a)
eAcq of
Left AcquireFailure
acqFailure -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO a)
-> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO a
forall a b. (a -> b) -> a -> b
$ AcquireFailure -> SophieQueryCmdError
SophieQueryCmdAcquireFailure AcquireFailure
acqFailure
Right Either EraMismatch a
eResult ->
case Either EraMismatch a
eResult of
Left EraMismatch
err -> SophieQueryCmdError -> ExceptT SophieQueryCmdError IO a
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (SophieQueryCmdError -> ExceptT SophieQueryCmdError IO a)
-> (SophieQueryCmdLocalStateQueryError -> SophieQueryCmdError)
-> SophieQueryCmdLocalStateQueryError
-> ExceptT SophieQueryCmdError IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SophieQueryCmdLocalStateQueryError -> SophieQueryCmdError
SophieQueryCmdLocalStateQueryError (SophieQueryCmdLocalStateQueryError
-> ExceptT SophieQueryCmdError IO a)
-> SophieQueryCmdLocalStateQueryError
-> ExceptT SophieQueryCmdError IO a
forall a b. (a -> b) -> a -> b
$ EraMismatch -> SophieQueryCmdLocalStateQueryError
EraMismatchError EraMismatch
err
Right a
result -> a -> ExceptT SophieQueryCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
obtainLedgerEraClassConstraints
:: SophieLedgerEra era ~ ledgerera
=> SophieBasedEra era
-> ((Ledger.SophieBased ledgerera
, ToJSON (DebugLedgerState era)
, FromCBOR (DebugLedgerState era)
, Era.Crypto ledgerera ~ StandardCrypto
) => a) -> a
obtainLedgerEraClassConstraints :: SophieBasedEra era
-> ((SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a)
-> a
obtainLedgerEraClassConstraints SophieBasedEra era
SophieBasedEraSophie (SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a
f = a
(SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a
f
obtainLedgerEraClassConstraints SophieBasedEra era
SophieBasedEraEvie (SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a
f = a
(SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a
f
obtainLedgerEraClassConstraints SophieBasedEra era
SophieBasedEraJen (SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a
f = a
(SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a
f
obtainLedgerEraClassConstraints SophieBasedEra era
SophieBasedEraAurum (SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a
f = a
(SophieBased ledgerera, ToJSON (DebugLedgerState era),
FromCBOR (DebugLedgerState era),
Crypto ledgerera ~ StandardCrypto) =>
a
f
queryQueryTip
:: LocalNodeConnectInfo BccMode
-> Maybe ChainPoint
-> IO (ChainTip, Either AcquireFailure O.QueryTipLocalState)
queryQueryTip :: LocalNodeConnectInfo BccMode
-> Maybe ChainPoint
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState)
queryQueryTip LocalNodeConnectInfo BccMode
connectInfo Maybe ChainPoint
mpoint = do
IO (ChainTip, Either AcquireFailure QueryTipLocalState)
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ChainTip, Either AcquireFailure QueryTipLocalState)
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState))
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState)
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo BccMode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
QueryTipLocalState)
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState)
forall mode a.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode mode) ChainPoint (QueryInMode mode) () IO a)
-> IO (ChainTip, Either AcquireFailure a)
executeLocalStateQueryExprWithChainSync LocalNodeConnectInfo BccMode
connectInfo Maybe ChainPoint
mpoint
((NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
QueryTipLocalState)
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState))
-> (NodeToClientVersion
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
QueryTipLocalState)
-> IO (ChainTip, Either AcquireFailure QueryTipLocalState)
forall a b. (a -> b) -> a -> b
$ \NodeToClientVersion
ntcVersion -> do
AnyBccEra
era <- QueryInMode BccMode AnyBccEra
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
AnyBccEra
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (ConsensusModeIsMultiEra BccMode -> QueryInMode BccMode AnyBccEra
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode AnyBccEra
QueryCurrentEra ConsensusModeIsMultiEra BccMode
BccModeIsMultiEra)
eraHistory :: EraHistory BccMode
eraHistory@(EraHistory ConsensusMode BccMode
_ Interpreter xs
interpreter)
<- QueryInMode BccMode (EraHistory BccMode)
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
(EraHistory BccMode)
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr (ConsensusModeIsMultiEra BccMode
-> QueryInMode BccMode (EraHistory BccMode)
forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
QueryEraHistory ConsensusModeIsMultiEra BccMode
BccModeIsMultiEra)
Maybe SystemStart
mSystemStart <- if NodeToClientVersion
ntcVersion NodeToClientVersion -> NodeToClientVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeToClientVersion
NodeToClientV_9
then SystemStart -> Maybe SystemStart
forall a. a -> Maybe a
Just (SystemStart -> Maybe SystemStart)
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
SystemStart
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
(Maybe SystemStart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryInMode BccMode SystemStart
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
SystemStart
forall mode a block point r.
QueryInMode mode a
-> LocalStateQueryExpr block point (QueryInMode mode) r IO a
queryExpr QueryInMode BccMode SystemStart
forall mode. QueryInMode mode SystemStart
QuerySystemStart
else Maybe SystemStart
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
(Maybe SystemStart)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SystemStart
forall a. Maybe a
Nothing
QueryTipLocalState
-> LocalStateQueryExpr
(BlockInMode BccMode)
ChainPoint
(QueryInMode BccMode)
()
IO
QueryTipLocalState
forall (m :: * -> *) a. Monad m => a -> m a
return QueryTipLocalState :: AnyBccEra
-> EraHistory BccMode
-> Maybe SystemStart
-> EpochInfo (Either TransactionValidityIntervalError)
-> QueryTipLocalState
O.QueryTipLocalState
{ $sel:era:QueryTipLocalState :: AnyBccEra
O.era = AnyBccEra
era
, $sel:eraHistory:QueryTipLocalState :: EraHistory BccMode
O.eraHistory = EraHistory BccMode
eraHistory
, $sel:mSystemStart:QueryTipLocalState :: Maybe SystemStart
O.mSystemStart = Maybe SystemStart
mSystemStart
, $sel:epochInfo:QueryTipLocalState :: EpochInfo (Either TransactionValidityIntervalError)
O.epochInfo = (forall a.
Except PastHorizonException a
-> Either TransactionValidityIntervalError a)
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either TransactionValidityIntervalError)
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo ((PastHorizonException -> TransactionValidityIntervalError)
-> Either PastHorizonException a
-> Either TransactionValidityIntervalError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first PastHorizonException -> TransactionValidityIntervalError
TransactionValidityIntervalError (Either PastHorizonException a
-> Either TransactionValidityIntervalError a)
-> (Except PastHorizonException a -> Either PastHorizonException a)
-> Except PastHorizonException a
-> Either TransactionValidityIntervalError a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Except PastHorizonException a -> Either PastHorizonException a
forall e a. Except e a -> Either e a
runExcept)
(EpochInfo (Except PastHorizonException)
-> EpochInfo (Either TransactionValidityIntervalError))
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either TransactionValidityIntervalError)
forall a b. (a -> b) -> a -> b
$ Interpreter xs -> EpochInfo (Except PastHorizonException)
forall (xs :: [*]).
Interpreter xs -> EpochInfo (Except PastHorizonException)
Consensus.interpreterToEpochInfo Interpreter xs
interpreter
}