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

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

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)

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

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

runQueryTip
  :: AnyConsensusModeParams
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT 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))

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

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


-- | Query the current and future parameters for a stake pool, including the retirement date.
-- Any of these may be empty (in which case a null will be displayed).
--

runQueryPoolParams
  :: AnyConsensusModeParams
  -> NetworkId
  -> Hash StakePoolKey
  -> ExceptT 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


-- | Obtain stake snapshot information for a pool, plus information about the total active stake.
-- This information can be used for leader slot calculation, for example, and has been requested by SPOs.
-- Obtaining the information directly is significantly more time and memory efficient than using a full ledger state dump.
runQueryStakeSnapshot
  :: AnyConsensusModeParams
  -> NetworkId
  -> Hash StakePoolKey
  -> ExceptT 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

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

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

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

-- | An error that can occur while querying a node's local state.
data SophieQueryCmdLocalStateQueryError
  = AcquireFailureError !LocalStateQuery.AcquireFailure
  | EraMismatchError !EraMismatch
  -- ^ A query from a certain era was applied to a ledger from a different
  -- era.
  | ColeProtocolNotSupportedError
  -- ^ The query does not support the Cole protocol.
  | SophieProtocolEraMismatch
  -- ^ The Sophie protocol only supports the Sophie era.
  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
    -- In the event of decode failure print the CBOR instead
    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
      -- Ledger State
      let (DebugLedgerState NewEpochState ledgerera
snapshot) = DebugLedgerState era
ledgerState

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

      -- Calculate the three pool and active stake values for the given pool
      IO () -> ExceptT 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
        }

-- | Sum all the stake that is held by the pool
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)

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

-- | This function obtains the pool parameters, equivalent to the following jq query on the output of query ledger-state
--   .nesEs.esLState._delegationState._pstate._pParams.<pool_id>
writePoolParams :: forall era ledgerera. ()
  => 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
    -- In the event of decode failure print the CBOR instead
    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

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

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

-- | A mapping of Sophie reward accounts to both the stake pool that they
-- delegate to and their reward account balance.
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
          ]

-- Helpers

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
          }