{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

module Cardano.CLI.Shelley.Run.Query
  ( ShelleyQueryCmdError
  , renderShelleyQueryCmdError
  , runQueryCmd
  ) where

import           Cardano.Prelude hiding (atomically)
import           Prelude (String)

import           Data.Aeson (ToJSON (..), (.=))
import qualified Data.Aeson as Aeson
import           Data.Aeson.Encode.Pretty (encodePretty)
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 Text
import qualified Data.Vector as Vector
import           Numeric (showEFloat)

import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, newExceptT)

import           Cardano.Api.LocalChainSync (getLocalTip)
import           Cardano.Api.Protocol
import           Cardano.Api.Typed

import           Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import           Cardano.CLI.Helpers (HelpersError, pPrintCBOR, renderHelpersError)
import           Cardano.CLI.Shelley.Orphans ()
import           Cardano.CLI.Shelley.Parsers (OutputFile (..), QueryCmd (..))
import           Cardano.CLI.Types

import           Cardano.Binary (decodeFull)
import           Cardano.Crypto.Hash (hashToBytesAsHex)

import           Ouroboros.Consensus.Cardano.Block (Either (..), EraMismatch (..), Query (..))
import           Ouroboros.Consensus.HardFork.Combinator.Degenerate (Either (DegenQueryResult),
                     Query (DegenQuery))
import           Ouroboros.Network.Block (Serialised (..), getTipPoint)

import qualified Shelley.Spec.Ledger.Address as Ledger
import qualified Shelley.Spec.Ledger.Credential as Ledger
import           Shelley.Spec.Ledger.Delegation.Certificates (IndividualPoolStake (..),
                     PoolDistr (..))
import qualified Shelley.Spec.Ledger.Keys as Ledger
import           Shelley.Spec.Ledger.LedgerState (NewEpochState)
import qualified Shelley.Spec.Ledger.LedgerState as Ledger
import           Shelley.Spec.Ledger.PParams (PParams)
import qualified Shelley.Spec.Ledger.TxBody as Ledger (TxId (..), TxIn (..), TxOut (..))
import qualified Shelley.Spec.Ledger.UTxO as Ledger (UTxO (..))

import           Ouroboros.Consensus.Shelley.Ledger
import           Ouroboros.Consensus.Shelley.Protocol (StandardCrypto)

import           Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
                     (AcquireFailure (..))


data ShelleyQueryCmdError
  = ShelleyQueryCmdEnvVarSocketErr !EnvSocketError
  | ShelleyQueryCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError
  | ShelleyQueryCmdWriteFileError !(FileError ())
  | ShelleyQueryCmdHelpersError !HelpersError
  deriving Int -> ShelleyQueryCmdError -> ShowS
[ShelleyQueryCmdError] -> ShowS
ShelleyQueryCmdError -> String
(Int -> ShelleyQueryCmdError -> ShowS)
-> (ShelleyQueryCmdError -> String)
-> ([ShelleyQueryCmdError] -> ShowS)
-> Show ShelleyQueryCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyQueryCmdError] -> ShowS
$cshowList :: [ShelleyQueryCmdError] -> ShowS
show :: ShelleyQueryCmdError -> String
$cshow :: ShelleyQueryCmdError -> String
showsPrec :: Int -> ShelleyQueryCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyQueryCmdError -> ShowS
Show

renderShelleyQueryCmdError :: ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError :: ShelleyQueryCmdError -> Text
renderShelleyQueryCmdError ShelleyQueryCmdError
err =
  case ShelleyQueryCmdError
err of
    ShelleyQueryCmdEnvVarSocketErr EnvSocketError
envSockErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
envSockErr
    ShelleyQueryCmdLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
lsqErr -> ShelleyQueryCmdLocalStateQueryError -> Text
renderLocalStateQueryError ShelleyQueryCmdLocalStateQueryError
lsqErr
    ShelleyQueryCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
    ShelleyQueryCmdHelpersError HelpersError
helpersErr -> HelpersError -> Text
renderHelpersError HelpersError
helpersErr

runQueryCmd :: QueryCmd -> ExceptT ShelleyQueryCmdError IO ()
runQueryCmd :: QueryCmd -> ExceptT ShelleyQueryCmdError IO ()
runQueryCmd QueryCmd
cmd =
  case QueryCmd
cmd of
    QueryProtocolParameters Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile ->
      Protocol
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile
    QueryTip Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile ->
      Protocol
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryTip Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile
    QueryStakeDistribution Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile ->
      Protocol
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile
    QueryStakeAddressInfo Protocol
protocol StakeAddress
addr NetworkId
network Maybe OutputFile
mOutFile ->
      Protocol
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo Protocol
protocol StakeAddress
addr NetworkId
network Maybe OutputFile
mOutFile
    QueryLedgerState Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile ->
      Protocol
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile
    QueryUTxO Protocol
protocol QueryFilter
qFilter NetworkId
networkId Maybe OutputFile
mOutFile ->
      Protocol
-> QueryFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO Protocol
protocol QueryFilter
qFilter NetworkId
networkId Maybe OutputFile
mOutFile


runQueryProtocolParameters
  :: Protocol
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters :: Protocol
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryProtocolParameters Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile = do
    SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr
                           ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
    PParams StandardShelley
pparams <- (ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
-> ExceptT ShelleyQueryCmdError IO (PParams StandardShelley)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError
ShelleyQueryCmdLocalStateQueryError (ExceptT
   ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
 -> ExceptT ShelleyQueryCmdError IO (PParams StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
-> ExceptT ShelleyQueryCmdError IO (PParams StandardShelley)
forall a b. (a -> b) -> a -> b
$
               Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block
    -> ExceptT
         ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
forall a.
Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block -> a)
-> a
withlocalNodeConnectInfo Protocol
protocol NetworkId
network String
sockPath
                 forall mode block.
LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
forall mode block.
RunNode block =>
LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
queryPParamsFromLocalState
    Maybe OutputFile
-> PParams StandardShelley -> ExceptT ShelleyQueryCmdError IO ()
writeProtocolParameters Maybe OutputFile
mOutFile PParams StandardShelley
pparams

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

runQueryTip
  :: Protocol
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryTip :: Protocol
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryTip Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile = do
    SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
    ByteString
output <-
      (ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString
-> ExceptT ShelleyQueryCmdError IO ByteString
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError
ShelleyQueryCmdLocalStateQueryError (ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString
 -> ExceptT ShelleyQueryCmdError IO ByteString)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString
-> ExceptT ShelleyQueryCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
      Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block
    -> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString
forall a.
Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block -> a)
-> a
withlocalNodeConnectInfo Protocol
protocol NetworkId
network String
sockPath ((forall mode block.
  RunNode block =>
  LocalNodeConnectInfo mode block
  -> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString)
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block
    -> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString
forall a b. (a -> b) -> a -> b
$ \LocalNodeConnectInfo mode block
connectInfo -> do
        Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
        let output :: ByteString
output = case LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode LocalNodeConnectInfo mode block
connectInfo of
                       ByronMode{}   -> Tip block -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Tip block
tip
                       ShelleyMode{} -> Tip block -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Tip block
tip
                       CardanoMode{} -> Tip block -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Tip block
tip
        ByteString
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
output
    case Maybe OutputFile
mOutFile of
      Just (OutputFile String
fpath) -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath ByteString
output
      Maybe OutputFile
Nothing                 -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn        ByteString
output


runQueryUTxO
  :: Protocol
  -> QueryFilter
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO :: Protocol
-> QueryFilter
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryUTxO Protocol
protocol QueryFilter
qfilter NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  UTxO StandardShelley
filteredUtxo <- (ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
-> ExceptT ShelleyQueryCmdError IO (UTxO StandardShelley)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError
ShelleyQueryCmdLocalStateQueryError (ExceptT
   ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
 -> ExceptT ShelleyQueryCmdError IO (UTxO StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
-> ExceptT ShelleyQueryCmdError IO (UTxO StandardShelley)
forall a b. (a -> b) -> a -> b
$
    Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block
    -> ExceptT
         ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
forall a.
Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block -> a)
-> a
withlocalNodeConnectInfo Protocol
protocol NetworkId
network String
sockPath (QueryFilter
-> LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
forall mode block.
QueryFilter
-> LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
queryUTxOFromLocalState QueryFilter
qfilter)
  Maybe OutputFile
-> UTxO StandardShelley -> ExceptT ShelleyQueryCmdError IO ()
writeFilteredUTxOs Maybe OutputFile
mOutFile UTxO StandardShelley
filteredUtxo

runQueryLedgerState
  :: Protocol
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState :: Protocol
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryLedgerState Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  Either ByteString (NewEpochState StandardShelley)
els <- (ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
-> ExceptT
     ShelleyQueryCmdError
     IO
     (Either ByteString (NewEpochState StandardShelley))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError
ShelleyQueryCmdLocalStateQueryError (ExceptT
   ShelleyQueryCmdLocalStateQueryError
   IO
   (Either ByteString (NewEpochState StandardShelley))
 -> ExceptT
      ShelleyQueryCmdError
      IO
      (Either ByteString (NewEpochState StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
-> ExceptT
     ShelleyQueryCmdError
     IO
     (Either ByteString (NewEpochState StandardShelley))
forall a b. (a -> b) -> a -> b
$
    Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block
    -> ExceptT
         ShelleyQueryCmdLocalStateQueryError
         IO
         (Either ByteString (NewEpochState StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
forall a.
Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block -> a)
-> a
withlocalNodeConnectInfo Protocol
protocol NetworkId
network String
sockPath forall mode blk.
LocalNodeConnectInfo mode blk
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
forall mode block.
RunNode block =>
LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
queryLocalLedgerState
  case Either ByteString (NewEpochState StandardShelley)
els of
    Right NewEpochState StandardShelley
lstate -> Maybe OutputFile
-> NewEpochState StandardShelley
-> ExceptT ShelleyQueryCmdError IO ()
writeLedgerState Maybe OutputFile
mOutFile NewEpochState StandardShelley
lstate
    Left ByteString
lbs -> do
      IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
putTextLn Text
"Version mismatch between node and consensus, so dumping this as generic CBOR."
      (HelpersError -> ShelleyQueryCmdError)
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT HelpersError -> ShelleyQueryCmdError
ShelleyQueryCmdHelpersError (ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ())
-> ExceptT HelpersError IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
lbs

runQueryStakeAddressInfo
  :: Protocol
  -> StakeAddress
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo :: Protocol
-> StakeAddress
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeAddressInfo Protocol
protocol StakeAddress
addr NetworkId
network Maybe OutputFile
mOutFile = do
    SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
    DelegationsAndRewards
delegsAndRwds <- (ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
-> ExceptT ShelleyQueryCmdError IO DelegationsAndRewards
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError
ShelleyQueryCmdLocalStateQueryError (ExceptT
   ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
 -> ExceptT ShelleyQueryCmdError IO DelegationsAndRewards)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
-> ExceptT ShelleyQueryCmdError IO DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$
      Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block
    -> ExceptT
         ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
forall a.
Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block -> a)
-> a
withlocalNodeConnectInfo
        Protocol
protocol
        NetworkId
network
        String
sockPath
        (Set StakeAddress
-> LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
forall mode block.
Set StakeAddress
-> LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
queryDelegationsAndRewardsFromLocalState (StakeAddress -> Set StakeAddress
forall a. a -> Set a
Set.singleton StakeAddress
addr))
    Maybe OutputFile
-> DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo Maybe OutputFile
mOutFile DelegationsAndRewards
delegsAndRwds

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

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

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

writeStakeAddressInfo
  :: Maybe OutputFile
  -> DelegationsAndRewards
  -> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo :: Maybe OutputFile
-> DelegationsAndRewards -> ExceptT ShelleyQueryCmdError IO ()
writeStakeAddressInfo Maybe OutputFile
mOutFile dr :: DelegationsAndRewards
dr@(DelegationsAndRewards NetworkId
_ Map
  (Credential 'Staking StandardShelley)
  (Maybe (Hash StakePoolKey), Coin)
_delegsAndRwds) =
  case Maybe OutputFile
mOutFile of
    Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
LBS.putStrLn (DelegationsAndRewards -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty DelegationsAndRewards
dr)
    Just (OutputFile String
fpath) ->
      (IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
        (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
fpath (DelegationsAndRewards -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty DelegationsAndRewards
dr)

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

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

printFilteredUTxOs :: Ledger.UTxO StandardShelley -> IO ()
printFilteredUTxOs :: UTxO StandardShelley -> IO ()
printFilteredUTxOs (Ledger.UTxO Map (TxIn StandardShelley) (TxOut StandardShelley)
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
'-'
    ((TxIn StandardShelley, TxOut StandardShelley) -> IO ())
-> [(TxIn StandardShelley, TxOut StandardShelley)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TxIn StandardShelley, TxOut StandardShelley) -> IO ()
printUtxo ([(TxIn StandardShelley, TxOut StandardShelley)] -> IO ())
-> [(TxIn StandardShelley, TxOut StandardShelley)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map (TxIn StandardShelley) (TxOut StandardShelley)
-> [(TxIn StandardShelley, TxOut StandardShelley)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (TxIn StandardShelley) (TxOut StandardShelley)
utxo
  where
    title :: Text
    title :: Text
title =
      Text
"                           TxHash                                 TxIx        Lovelace"

    printUtxo :: (Ledger.TxIn StandardShelley, Ledger.TxOut StandardShelley) -> IO ()
    printUtxo :: (TxIn StandardShelley, TxOut StandardShelley) -> IO ()
printUtxo (Ledger.TxIn (Ledger.TxId Hash (Crypto StandardShelley) EraIndependentTxBody
txhash) Natural
txin , Ledger.TxOut Addr StandardShelley
_ (Coin coin)) =
      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 Blake2b_256 EraIndependentTxBody
Hash (Crypto StandardShelley) EraIndependentTxBody
txhash)
          , Int -> Natural -> Text
forall a. Show a => Int -> a -> Text
textShowN Int
6 Natural
txin
          , Int -> Integer -> Text
forall a. Show a => Int -> a -> Text
textShowN Int
18 Integer
coin -- enough to display maxLovelaceVal
          ]

    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

runQueryStakeDistribution
  :: Protocol
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution :: Protocol
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyQueryCmdError IO ()
runQueryStakeDistribution Protocol
protocol NetworkId
network Maybe OutputFile
mOutFile = do
  SocketPath String
sockPath <- (EnvSocketError -> ShelleyQueryCmdError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ShelleyQueryCmdError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ShelleyQueryCmdError
ShelleyQueryCmdEnvVarSocketErr ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
  PoolDistr StandardCrypto
stakeDist <- (ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
-> ExceptT ShelleyQueryCmdError IO (PoolDistr StandardCrypto)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyQueryCmdLocalStateQueryError -> ShelleyQueryCmdError
ShelleyQueryCmdLocalStateQueryError (ExceptT
   ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
 -> ExceptT ShelleyQueryCmdError IO (PoolDistr StandardCrypto))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
-> ExceptT ShelleyQueryCmdError IO (PoolDistr StandardCrypto)
forall a b. (a -> b) -> a -> b
$
      Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block
    -> ExceptT
         ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
forall a.
Protocol
-> NetworkId
-> String
-> (forall mode block.
    RunNode block =>
    LocalNodeConnectInfo mode block -> a)
-> a
withlocalNodeConnectInfo
        Protocol
protocol
        NetworkId
network
        String
sockPath
        forall mode block.
LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
forall mode block.
RunNode block =>
LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
queryStakeDistributionFromLocalState
  Maybe OutputFile
-> PoolDistr StandardCrypto -> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution Maybe OutputFile
mOutFile PoolDistr StandardCrypto
stakeDist

writeStakeDistribution :: Maybe OutputFile
                       -> PoolDistr StandardCrypto
                       -> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution :: Maybe OutputFile
-> PoolDistr StandardCrypto -> ExceptT ShelleyQueryCmdError IO ()
writeStakeDistribution (Just (OutputFile String
outFile)) (PoolDistr Map
  (KeyHash 'StakePool StandardCrypto)
  (IndividualPoolStake StandardCrypto)
stakeDist) =
    (IOException -> ShelleyQueryCmdError)
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyQueryCmdError
ShelleyQueryCmdWriteFileError (FileError () -> ShelleyQueryCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyQueryCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
outFile) (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      String -> ByteString -> IO ()
LBS.writeFile String
outFile (Map
  (KeyHash 'StakePool StandardCrypto)
  (IndividualPoolStake StandardCrypto)
-> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Map
  (KeyHash 'StakePool StandardCrypto)
  (IndividualPoolStake StandardCrypto)
stakeDist)

writeStakeDistribution Maybe OutputFile
Nothing PoolDistr StandardCrypto
stakeDist =
   IO () -> ExceptT ShelleyQueryCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyQueryCmdError IO ())
-> IO () -> ExceptT ShelleyQueryCmdError IO ()
forall a b. (a -> b) -> a -> b
$ PoolDistr StandardCrypto -> IO ()
printStakeDistribution PoolDistr StandardCrypto
stakeDist

printStakeDistribution :: PoolDistr StandardCrypto -> IO ()
printStakeDistribution :: PoolDistr StandardCrypto -> IO ()
printStakeDistribution (PoolDistr Map
  (KeyHash 'StakePool StandardCrypto)
  (IndividualPoolStake StandardCrypto)
stakeDist) = 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 -> Hash VrfKey -> String
showStakeDistr (KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey
StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolId) Rational
stakeFraction (Hash StandardCrypto (VerKeyVRF StandardCrypto) -> Hash VrfKey
VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfKeyId)
      | (KeyHash 'StakePool StandardCrypto
poolId, IndividualPoolStake Rational
stakeFraction Hash StandardCrypto (VerKeyVRF StandardCrypto)
vrfKeyId) <- Map
  (KeyHash 'StakePool StandardCrypto)
  (IndividualPoolStake StandardCrypto)
-> [(KeyHash 'StakePool StandardCrypto,
     IndividualPoolStake StandardCrypto)]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  (KeyHash 'StakePool StandardCrypto)
  (IndividualPoolStake StandardCrypto)
stakeDist ]
  where
    title :: Text
    title :: Text
title =
      Text
"                           PoolId                                 Stake frac"

    showStakeDistr :: PoolId
                   -> Rational
                   -> Hash VrfKey
                   -> String
    showStakeDistr :: Hash StakePoolKey -> Rational -> Hash VrfKey -> String
showStakeDistr Hash StakePoolKey
poolId Rational
stakeFraction Hash VrfKey
_vrfKeyId =
      [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
""
-- TODO: we could show the VRF id, but it will then not fit in 80 cols
--      , show vrfKeyId
        ]


-- From Cardano.Api

-- | Query the UTxO, filtered by a given set of addresses, from a Shelley node
-- via the local state query protocol.
--
-- This one is Shelley-specific because the query is Shelley-specific.
--
queryUTxOFromLocalState
  :: QueryFilter
  -> LocalNodeConnectInfo mode block
  -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Ledger.UTxO StandardShelley)
queryUTxOFromLocalState :: QueryFilter
-> LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
queryUTxOFromLocalState QueryFilter
qFilter connectInfo :: LocalNodeConnectInfo mode block
connectInfo@LocalNodeConnectInfo{NodeConsensusMode mode block
localNodeConsensusMode :: NodeConsensusMode mode block
localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode} =
  case NodeConsensusMode mode block
localNodeConsensusMode of
    ByronMode{} -> ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ShelleyQueryCmdLocalStateQueryError
ByronProtocolNotSupportedError

    ShelleyMode{} -> do
      Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
      DegenQueryResult UTxO StandardShelley
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (UTxO StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (UTxO StandardShelley))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (HardForkQueryResult
      '[ShelleyBlock StandardShelley] (UTxO StandardShelley))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
-> (IO
      (Either
         AcquireFailure
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
    -> ExceptT
         AcquireFailure
         IO
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (UTxO StandardShelley))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (UTxO StandardShelley))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (UTxO StandardShelley))
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo mode block
-> (Point block,
    Query
      block
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (UTxO StandardShelley)))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
          LocalNodeConnectInfo mode block
connectInfo
          (Tip block -> Point block
forall b. Tip b -> Point b
getTipPoint Tip block
tip, Query (ShelleyBlock StandardShelley) (UTxO StandardShelley)
-> Query
     (HardForkBlock '[ShelleyBlock StandardShelley])
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (UTxO StandardShelley))
forall b a result.
(HardForkQueryResult '[b] result ~ a) =>
Query b result -> Query (HardForkBlock '[b]) a
DegenQuery (QueryFilter
-> Query (ShelleyBlock StandardShelley) (UTxO StandardShelley)
applyUTxOFilter QueryFilter
qFilter))
      UTxO StandardShelley
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
forall (m :: * -> *) a. Monad m => a -> m a
return UTxO StandardShelley
result

    CardanoMode{} -> do
      Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
      CardanoQueryResult StandardCrypto (UTxO StandardShelley)
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult StandardCrypto (UTxO StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (UTxO StandardShelley))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (CardanoQueryResult StandardCrypto (UTxO StandardShelley))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
-> (IO
      (Either
         AcquireFailure
         (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
    -> ExceptT
         AcquireFailure
         IO
         (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (UTxO StandardShelley))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult StandardCrypto (UTxO StandardShelley))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (UTxO StandardShelley))
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo mode block
-> (Point block,
    Query
      block (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (UTxO StandardShelley)))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
          LocalNodeConnectInfo mode block
connectInfo
          (Tip block -> Point block
forall b. Tip b -> Point b
getTipPoint Tip block
tip, Query (ShelleyBlock StandardShelley) (UTxO StandardShelley)
-> CardanoQuery
     StandardCrypto
     (CardanoQueryResult StandardCrypto (UTxO StandardShelley))
forall c a result.
(CardanoQueryResult c result ~ a) =>
Query (ShelleyBlock (ShelleyEra c)) result -> CardanoQuery c a
QueryIfCurrentShelley (QueryFilter
-> Query (ShelleyBlock StandardShelley) (UTxO StandardShelley)
applyUTxOFilter QueryFilter
qFilter))
      case CardanoQueryResult StandardCrypto (UTxO StandardShelley)
result of
        QueryResultEraMismatch EraMismatch
err -> ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EraMismatch -> ShelleyQueryCmdLocalStateQueryError
EraMismatchError EraMismatch
err)
        QueryResultSuccess UTxO StandardShelley
utxo -> UTxO StandardShelley
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (UTxO StandardShelley)
forall (m :: * -> *) a. Monad m => a -> m a
return UTxO StandardShelley
utxo
  where
    applyUTxOFilter :: QueryFilter
-> Query (ShelleyBlock StandardShelley) (UTxO StandardShelley)
applyUTxOFilter (FilterByAddress Set (Address Shelley)
as) = Set (Addr StandardShelley)
-> Query (ShelleyBlock StandardShelley) (UTxO StandardShelley)
forall era. Set (Addr era) -> Query (ShelleyBlock era) (UTxO era)
GetFilteredUTxO (Set (Address Shelley) -> Set (Addr StandardShelley)
toShelleyAddrs Set (Address Shelley)
as)
    applyUTxOFilter QueryFilter
NoFilter             = Query (ShelleyBlock StandardShelley) (UTxO StandardShelley)
forall era. Query (ShelleyBlock era) (UTxO era)
GetUTxO

    -- TODO: ultimately, these should be exported from Cardano.API.Shelley
    -- for the Shelley-specific types and conversion for the API wrapper types.
    -- But alternatively, the API can also be extended to cover the queries
    -- properly using the API types.

    toShelleyAddrs :: Set (Address Shelley) -> Set (Ledger.Addr StandardShelley)
    toShelleyAddrs :: Set (Address Shelley) -> Set (Addr StandardShelley)
toShelleyAddrs = (Address Shelley -> Addr StandardShelley)
-> Set (Address Shelley) -> Set (Addr StandardShelley)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Address Shelley -> Addr StandardShelley
forall era. Address era -> Addr StandardShelley
toShelleyAddr

    toShelleyAddr :: Address era -> Ledger.Addr StandardShelley
    toShelleyAddr :: Address era -> Addr StandardShelley
toShelleyAddr (ByronAddress Address
addr)        = BootstrapAddress StandardShelley -> Addr StandardShelley
forall era. BootstrapAddress era -> Addr era
Ledger.AddrBootstrap
                                                 (Address -> BootstrapAddress StandardShelley
forall era. Address -> BootstrapAddress era
Ledger.BootstrapAddress Address
addr)
    toShelleyAddr (ShelleyAddress Network
nw PaymentCredential StandardShelley
pc StakeReference StandardShelley
scr) = Network
-> PaymentCredential StandardShelley
-> StakeReference StandardShelley
-> Addr StandardShelley
forall era.
Network -> PaymentCredential era -> StakeReference era -> Addr era
Ledger.Addr Network
nw PaymentCredential StandardShelley
pc StakeReference StandardShelley
scr


-- | A mapping of Shelley reward accounts to both the stake pool that they
-- delegate to and their reward account balance.
data DelegationsAndRewards
  = DelegationsAndRewards
      !NetworkId
      !(Map (Ledger.Credential Ledger.Staking StandardShelley)
            (Maybe (Hash StakePoolKey), Coin))

instance ToJSON DelegationsAndRewards where
  toJSON :: DelegationsAndRewards -> Value
toJSON (DelegationsAndRewards NetworkId
nw Map
  (Credential 'Staking StandardShelley)
  (Maybe (Hash StakePoolKey), Coin)
delegsAndRwds) =
      Array -> Value
Aeson.Array (Array -> Value)
-> ([(Credential 'Staking StandardShelley,
      (Maybe (Hash StakePoolKey), Coin))]
    -> Array)
-> [(Credential 'Staking StandardShelley,
     (Maybe (Hash StakePoolKey), Coin))]
-> 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)
-> ([(Credential 'Staking StandardShelley,
      (Maybe (Hash StakePoolKey), Coin))]
    -> [Value])
-> [(Credential 'Staking StandardShelley,
     (Maybe (Hash StakePoolKey), Coin))]
-> Array
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Credential 'Staking StandardShelley,
  (Maybe (Hash StakePoolKey), Coin))
 -> Value)
-> [(Credential 'Staking StandardShelley,
     (Maybe (Hash StakePoolKey), Coin))]
-> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Credential 'Staking StandardShelley,
 (Maybe (Hash StakePoolKey), Coin))
-> Value
delegAndRwdToJson ([(Credential 'Staking StandardShelley,
   (Maybe (Hash StakePoolKey), Coin))]
 -> Value)
-> [(Credential 'Staking StandardShelley,
     (Maybe (Hash StakePoolKey), Coin))]
-> Value
forall a b. (a -> b) -> a -> b
$ Map
  (Credential 'Staking StandardShelley)
  (Maybe (Hash StakePoolKey), Coin)
-> [(Credential 'Staking StandardShelley,
     (Maybe (Hash StakePoolKey), Coin))]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  (Credential 'Staking StandardShelley)
  (Maybe (Hash StakePoolKey), Coin)
delegsAndRwds
    where
      delegAndRwdToJson
        :: (Ledger.Credential Ledger.Staking StandardShelley, (Maybe (Hash StakePoolKey), Coin))
        -> Aeson.Value
      delegAndRwdToJson :: (Credential 'Staking StandardShelley,
 (Maybe (Hash StakePoolKey), Coin))
-> Value
delegAndRwdToJson (Credential 'Staking StandardShelley
k, (Maybe (Hash StakePoolKey)
d, Coin
r)) =
        [Pair] -> Value
Aeson.object
          [ Text
"address" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Credential 'Staking StandardShelley -> Text
renderAddress Credential 'Staking StandardShelley
k
          , Text
"delegation" Text -> Maybe (Hash StakePoolKey) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (Hash StakePoolKey)
d
          , Text
"rewardAccountBalance" Text -> Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
r
          ]

      renderAddress :: Ledger.Credential Ledger.Staking StandardShelley -> Text
      renderAddress :: Credential 'Staking StandardShelley -> Text
renderAddress = StakeAddress -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress (StakeAddress -> Text)
-> (Credential 'Staking StandardShelley -> StakeAddress)
-> Credential 'Staking StandardShelley
-> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Network -> Credential 'Staking StandardShelley -> StakeAddress
StakeAddress (NetworkId -> Network
toShelleyNetwork NetworkId
nw)


-- | Query the current protocol parameters from a Shelley node via the local
-- state query protocol.
--
-- This one is Shelley-specific because the query is Shelley-specific.
--
queryPParamsFromLocalState
  :: LocalNodeConnectInfo mode block
  -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
queryPParamsFromLocalState :: LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
queryPParamsFromLocalState LocalNodeConnectInfo{
                             localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode = ByronMode{}
                           } =
    ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ShelleyQueryCmdLocalStateQueryError
ByronProtocolNotSupportedError

queryPParamsFromLocalState connectInfo :: LocalNodeConnectInfo mode block
connectInfo@LocalNodeConnectInfo{
                             localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode = NodeConsensusMode mode block
ShelleyMode
                           } = do
    Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
    DegenQueryResult PParams StandardShelley
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PParams StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PParams StandardShelley))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (HardForkQueryResult
      '[ShelleyBlock StandardShelley] (PParams StandardShelley))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
-> (IO
      (Either
         AcquireFailure
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
    -> ExceptT
         AcquireFailure
         IO
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PParams StandardShelley))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PParams StandardShelley))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PParams StandardShelley))
forall a b. (a -> b) -> a -> b
$
      LocalNodeConnectInfo mode block
-> (Point block,
    Query
      block
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (PParams StandardShelley)))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
        LocalNodeConnectInfo mode block
connectInfo
        (Tip block -> Point block
forall b. Tip b -> Point b
getTipPoint Tip block
tip, Query (ShelleyBlock StandardShelley) (PParams StandardShelley)
-> Query
     (HardForkBlock '[ShelleyBlock StandardShelley])
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PParams StandardShelley))
forall b a result.
(HardForkQueryResult '[b] result ~ a) =>
Query b result -> Query (HardForkBlock '[b]) a
DegenQuery Query (ShelleyBlock StandardShelley) (PParams StandardShelley)
forall era. Query (ShelleyBlock era) (PParams' Identity era)
GetCurrentPParams)
    PParams StandardShelley
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
forall (m :: * -> *) a. Monad m => a -> m a
return PParams StandardShelley
result

queryPParamsFromLocalState connectInfo :: LocalNodeConnectInfo mode block
connectInfo@LocalNodeConnectInfo{
                             localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode = CardanoMode{}
                           } = do
    Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
    CardanoQueryResult StandardCrypto (PParams StandardShelley)
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult StandardCrypto (PParams StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (PParams StandardShelley))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (CardanoQueryResult StandardCrypto (PParams StandardShelley))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
-> (IO
      (Either
         AcquireFailure
         (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
    -> ExceptT
         AcquireFailure
         IO
         (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (PParams StandardShelley))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult StandardCrypto (PParams StandardShelley))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (PParams StandardShelley))
forall a b. (a -> b) -> a -> b
$
      LocalNodeConnectInfo mode block
-> (Point block,
    Query
      block
      (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (PParams StandardShelley)))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
        LocalNodeConnectInfo mode block
connectInfo
        (Tip block -> Point block
forall b. Tip b -> Point b
getTipPoint Tip block
tip, Query (ShelleyBlock StandardShelley) (PParams StandardShelley)
-> CardanoQuery
     StandardCrypto
     (CardanoQueryResult StandardCrypto (PParams StandardShelley))
forall c a result.
(CardanoQueryResult c result ~ a) =>
Query (ShelleyBlock (ShelleyEra c)) result -> CardanoQuery c a
QueryIfCurrentShelley Query (ShelleyBlock StandardShelley) (PParams StandardShelley)
forall era. Query (ShelleyBlock era) (PParams' Identity era)
GetCurrentPParams)
    case CardanoQueryResult StandardCrypto (PParams StandardShelley)
result of
      QueryResultEraMismatch EraMismatch
eraerr  -> ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EraMismatch -> ShelleyQueryCmdLocalStateQueryError
EraMismatchError EraMismatch
eraerr)
      QueryResultSuccess     PParams StandardShelley
pparams -> PParams StandardShelley
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PParams StandardShelley)
forall (m :: * -> *) a. Monad m => a -> m a
return PParams StandardShelley
pparams


-- | Query the current stake distribution from a Shelley node via the local
-- state query protocol.
--
-- This one is Shelley-specific because the query is Shelley-specific.
--
queryStakeDistributionFromLocalState
  :: LocalNodeConnectInfo mode block
  -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
queryStakeDistributionFromLocalState :: LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
queryStakeDistributionFromLocalState LocalNodeConnectInfo{
                                       localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode = ByronMode{}
                                     } =
  ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ShelleyQueryCmdLocalStateQueryError
ByronProtocolNotSupportedError

queryStakeDistributionFromLocalState connectInfo :: LocalNodeConnectInfo mode block
connectInfo@LocalNodeConnectInfo{
                                       localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode = ShelleyMode{}
                                     } = do
  Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
  DegenQueryResult PoolDistr StandardCrypto
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (HardForkQueryResult
      '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
-> (IO
      (Either
         AcquireFailure
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
    -> ExceptT
         AcquireFailure
         IO
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto))
forall a b. (a -> b) -> a -> b
$
    LocalNodeConnectInfo mode block
-> (Point block,
    Query
      block
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto)))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
      LocalNodeConnectInfo mode block
connectInfo
      (Tip block -> Point block
forall b. Tip b -> Point b
getTipPoint Tip block
tip, Query (ShelleyBlock StandardShelley) (PoolDistr StandardCrypto)
-> Query
     (HardForkBlock '[ShelleyBlock StandardShelley])
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley] (PoolDistr StandardCrypto))
forall b a result.
(HardForkQueryResult '[b] result ~ a) =>
Query b result -> Query (HardForkBlock '[b]) a
DegenQuery Query (ShelleyBlock StandardShelley) (PoolDistr StandardCrypto)
forall era. Query (ShelleyBlock era) (PoolDistr (EraCrypto era))
GetStakeDistribution)
  PoolDistr StandardCrypto
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
forall (m :: * -> *) a. Monad m => a -> m a
return PoolDistr StandardCrypto
result

queryStakeDistributionFromLocalState connectInfo :: LocalNodeConnectInfo mode block
connectInfo@LocalNodeConnectInfo{
                                       localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode = CardanoMode{}
                                     } = do
  Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
  CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
-> (IO
      (Either
         AcquireFailure
         (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
    -> ExceptT
         AcquireFailure
         IO
         (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto))
forall a b. (a -> b) -> a -> b
$
    LocalNodeConnectInfo mode block
-> (Point block,
    Query
      block
      (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
      LocalNodeConnectInfo mode block
connectInfo
      (Tip block -> Point block
forall b. Tip b -> Point b
getTipPoint Tip block
tip, Query (ShelleyBlock StandardShelley) (PoolDistr StandardCrypto)
-> CardanoQuery
     StandardCrypto
     (CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto))
forall c a result.
(CardanoQueryResult c result ~ a) =>
Query (ShelleyBlock (ShelleyEra c)) result -> CardanoQuery c a
QueryIfCurrentShelley Query (ShelleyBlock StandardShelley) (PoolDistr StandardCrypto)
forall era. Query (ShelleyBlock era) (PoolDistr (EraCrypto era))
GetStakeDistribution)
  case CardanoQueryResult StandardCrypto (PoolDistr StandardCrypto)
result of
    QueryResultEraMismatch EraMismatch
err -> ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EraMismatch -> ShelleyQueryCmdLocalStateQueryError
EraMismatchError EraMismatch
err)
    QueryResultSuccess PoolDistr StandardCrypto
stakeDist -> PoolDistr StandardCrypto
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO (PoolDistr StandardCrypto)
forall (m :: * -> *) a. Monad m => a -> m a
return PoolDistr StandardCrypto
stakeDist

queryLocalLedgerState
  :: LocalNodeConnectInfo mode blk
  -> ExceptT ShelleyQueryCmdLocalStateQueryError IO
             (Either LByteString (NewEpochState StandardShelley))
queryLocalLedgerState :: LocalNodeConnectInfo mode blk
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
queryLocalLedgerState connectInfo :: LocalNodeConnectInfo mode blk
connectInfo@LocalNodeConnectInfo{NodeConsensusMode mode blk
localNodeConsensusMode :: NodeConsensusMode mode blk
localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode} =
  case NodeConsensusMode mode blk
localNodeConsensusMode of
    ByronMode{} -> ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ShelleyQueryCmdLocalStateQueryError
ByronProtocolNotSupportedError

    ShelleyMode{} -> do
      Tip blk
tip <- IO (Tip blk)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip blk)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip blk)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip blk))
-> IO (Tip blk)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip blk)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode blk -> IO (Tip blk)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode blk
connectInfo
      DegenQueryResult Serialised (NewEpochState StandardShelley)
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Serialised (NewEpochState StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Serialised (NewEpochState StandardShelley)))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (HardForkQueryResult
      '[ShelleyBlock StandardShelley]
      (Serialised (NewEpochState StandardShelley)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Serialised (NewEpochState StandardShelley))))
-> (IO
      (Either
         AcquireFailure
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley]
            (Serialised (NewEpochState StandardShelley))))
    -> ExceptT
         AcquireFailure
         IO
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley]
            (Serialised (NewEpochState StandardShelley))))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley]
           (Serialised (NewEpochState StandardShelley))))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Serialised (NewEpochState StandardShelley)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Serialised (NewEpochState StandardShelley))))
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Serialised (NewEpochState StandardShelley)))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Serialised (NewEpochState StandardShelley))))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Serialised (NewEpochState StandardShelley))))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley]
           (Serialised (NewEpochState StandardShelley))))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Serialised (NewEpochState StandardShelley)))
forall a b. (a -> b) -> a -> b
$
          LocalNodeConnectInfo mode blk
-> (Point blk,
    Query
      blk
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Serialised (NewEpochState StandardShelley))))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley]
           (Serialised (NewEpochState StandardShelley))))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
            LocalNodeConnectInfo mode blk
connectInfo
            ( Tip blk -> Point blk
forall b. Tip b -> Point b
getTipPoint Tip blk
tip
            , Query
  (ShelleyBlock StandardShelley)
  (Serialised (NewEpochState StandardShelley))
-> Query
     (HardForkBlock '[ShelleyBlock StandardShelley])
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Serialised (NewEpochState StandardShelley)))
forall b a result.
(HardForkQueryResult '[b] result ~ a) =>
Query b result -> Query (HardForkBlock '[b]) a
DegenQuery (Query
   (ShelleyBlock StandardShelley)
   (Serialised (NewEpochState StandardShelley))
 -> Query
      (HardForkBlock '[ShelleyBlock StandardShelley])
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Serialised (NewEpochState StandardShelley))))
-> Query
     (ShelleyBlock StandardShelley)
     (Serialised (NewEpochState StandardShelley))
-> Query
     (HardForkBlock '[ShelleyBlock StandardShelley])
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Serialised (NewEpochState StandardShelley)))
forall a b. (a -> b) -> a -> b
$
                Query
  (ShelleyBlock StandardShelley) (NewEpochState StandardShelley)
-> Query
     (ShelleyBlock StandardShelley)
     (Serialised (NewEpochState StandardShelley))
forall era result.
Query (ShelleyBlock era) result
-> Query (ShelleyBlock era) (Serialised result)
GetCBOR Query
  (ShelleyBlock StandardShelley) (NewEpochState StandardShelley)
forall era. Query (ShelleyBlock era) (NewEpochState era)
DebugNewEpochState  -- Get CBOR-in-CBOR version
            )
      Either ByteString (NewEpochState StandardShelley)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
forall (m :: * -> *) a. Monad m => a -> m a
return (Serialised (NewEpochState StandardShelley)
-> Either ByteString (NewEpochState StandardShelley)
forall c a. FromCBOR c => Serialised a -> Either ByteString c
decodeLedgerState Serialised (NewEpochState StandardShelley)
result)

    CardanoMode{} -> do
      Tip blk
tip <- IO (Tip blk)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip blk)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip blk)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip blk))
-> IO (Tip blk)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip blk)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode blk -> IO (Tip blk)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode blk
connectInfo
      CardanoQueryResult
  StandardCrypto (Serialised (NewEpochState StandardShelley))
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult
        StandardCrypto (Serialised (NewEpochState StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult
        StandardCrypto (Serialised (NewEpochState StandardShelley)))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (CardanoQueryResult
      StandardCrypto (Serialised (NewEpochState StandardShelley)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult
         StandardCrypto (Serialised (NewEpochState StandardShelley))))
-> (IO
      (Either
         AcquireFailure
         (CardanoQueryResult
            StandardCrypto (Serialised (NewEpochState StandardShelley))))
    -> ExceptT
         AcquireFailure
         IO
         (CardanoQueryResult
            StandardCrypto (Serialised (NewEpochState StandardShelley))))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult
           StandardCrypto (Serialised (NewEpochState StandardShelley))))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult
        StandardCrypto (Serialised (NewEpochState StandardShelley)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (CardanoQueryResult
        StandardCrypto (Serialised (NewEpochState StandardShelley))))
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult
        StandardCrypto (Serialised (NewEpochState StandardShelley)))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (CardanoQueryResult
         StandardCrypto (Serialised (NewEpochState StandardShelley))))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult
         StandardCrypto (Serialised (NewEpochState StandardShelley))))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult
           StandardCrypto (Serialised (NewEpochState StandardShelley))))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult
        StandardCrypto (Serialised (NewEpochState StandardShelley)))
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo mode blk
-> (Point blk,
    Query
      blk
      (CardanoQueryResult
         StandardCrypto (Serialised (NewEpochState StandardShelley))))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult
           StandardCrypto (Serialised (NewEpochState StandardShelley))))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
          LocalNodeConnectInfo mode blk
connectInfo
          (Tip blk -> Point blk
forall b. Tip b -> Point b
getTipPoint Tip blk
tip, Query
  (ShelleyBlock StandardShelley)
  (Serialised (NewEpochState StandardShelley))
-> CardanoQuery
     StandardCrypto
     (CardanoQueryResult
        StandardCrypto (Serialised (NewEpochState StandardShelley)))
forall c a result.
(CardanoQueryResult c result ~ a) =>
Query (ShelleyBlock (ShelleyEra c)) result -> CardanoQuery c a
QueryIfCurrentShelley (Query
  (ShelleyBlock StandardShelley) (NewEpochState StandardShelley)
-> Query
     (ShelleyBlock StandardShelley)
     (Serialised (NewEpochState StandardShelley))
forall era result.
Query (ShelleyBlock era) result
-> Query (ShelleyBlock era) (Serialised result)
GetCBOR Query
  (ShelleyBlock StandardShelley) (NewEpochState StandardShelley)
forall era. Query (ShelleyBlock era) (NewEpochState era)
DebugNewEpochState)) -- Get CBOR-in-CBOR version
      case CardanoQueryResult
  StandardCrypto (Serialised (NewEpochState StandardShelley))
result of
        QueryResultEraMismatch EraMismatch
err -> ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EraMismatch -> ShelleyQueryCmdLocalStateQueryError
EraMismatchError EraMismatch
err)
        QueryResultSuccess Serialised (NewEpochState StandardShelley)
ls -> Either ByteString (NewEpochState StandardShelley)
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (Either ByteString (NewEpochState StandardShelley))
forall (m :: * -> *) a. Monad m => a -> m a
return (Serialised (NewEpochState StandardShelley)
-> Either ByteString (NewEpochState StandardShelley)
forall c a. FromCBOR c => Serialised a -> Either ByteString c
decodeLedgerState Serialised (NewEpochState StandardShelley)
ls)
  where
    -- If decode as a LedgerState fails we return the ByteString so we can do a generic
    -- CBOR decode.
    decodeLedgerState :: Serialised a -> Either ByteString c
decodeLedgerState (Serialised ByteString
lbs) =
      (DecoderError -> ByteString)
-> Either DecoderError c -> Either ByteString c
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
lbs) (ByteString -> Either DecoderError c
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull ByteString
lbs)


-- | Query the current delegations and reward accounts, filtered by a given
-- set of addresses, from a Shelley node via the local state query protocol.
--
-- This one is Shelley-specific because the query is Shelley-specific.
--
queryDelegationsAndRewardsFromLocalState
  :: Set StakeAddress
  -> LocalNodeConnectInfo mode block
  -> ExceptT ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
queryDelegationsAndRewardsFromLocalState :: Set StakeAddress
-> LocalNodeConnectInfo mode block
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
queryDelegationsAndRewardsFromLocalState Set StakeAddress
stakeaddrs
                                         connectInfo :: LocalNodeConnectInfo mode block
connectInfo@LocalNodeConnectInfo{
                                           NetworkId
localNodeNetworkId :: forall mode block. LocalNodeConnectInfo mode block -> NetworkId
localNodeNetworkId :: NetworkId
localNodeNetworkId,
                                           NodeConsensusMode mode block
localNodeConsensusMode :: NodeConsensusMode mode block
localNodeConsensusMode :: forall mode block.
LocalNodeConnectInfo mode block -> NodeConsensusMode mode block
localNodeConsensusMode
                                         } =
  case NodeConsensusMode mode block
localNodeConsensusMode of
    ByronMode{} -> ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ShelleyQueryCmdLocalStateQueryError
ByronProtocolNotSupportedError

    ShelleyMode{} -> do
      Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
      DegenQueryResult (Map
   (Credential 'Staking StandardShelley)
   (KeyHash 'StakePool StandardCrypto),
 RewardAccounts StandardShelley)
result <-
        (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (HardForkQueryResult
      '[ShelleyBlock StandardShelley]
      (Map
         (Credential 'Staking StandardShelley)
         (KeyHash 'StakePool StandardCrypto),
       RewardAccounts StandardShelley))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
-> (IO
      (Either
         AcquireFailure
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley]
            (Map
               (Credential 'Staking StandardShelley)
               (KeyHash 'StakePool StandardCrypto),
             RewardAccounts StandardShelley)))
    -> ExceptT
         AcquireFailure
         IO
         (HardForkQueryResult
            '[ShelleyBlock StandardShelley]
            (Map
               (Credential 'Staking StandardShelley)
               (KeyHash 'StakePool StandardCrypto),
             RewardAccounts StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley]
           (Map
              (Credential 'Staking StandardShelley)
              (KeyHash 'StakePool StandardCrypto),
            RewardAccounts StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley)))
-> ExceptT
     AcquireFailure
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley]
           (Map
              (Credential 'Staking StandardShelley)
              (KeyHash 'StakePool StandardCrypto),
            RewardAccounts StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall a b. (a -> b) -> a -> b
$
          LocalNodeConnectInfo mode block
-> (Point block,
    Query
      block
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (HardForkQueryResult
           '[ShelleyBlock StandardShelley]
           (Map
              (Credential 'Staking StandardShelley)
              (KeyHash 'StakePool StandardCrypto),
            RewardAccounts StandardShelley)))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
            LocalNodeConnectInfo mode block
connectInfo
            ( Tip block -> Point block
forall b. Tip b -> Point b
getTipPoint Tip block
tip
            , Query
  (ShelleyBlock StandardShelley)
  (Map
     (Credential 'Staking StandardShelley)
     (KeyHash 'StakePool StandardCrypto),
   RewardAccounts StandardShelley)
-> Query
     (HardForkBlock '[ShelleyBlock StandardShelley])
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall b a result.
(HardForkQueryResult '[b] result ~ a) =>
Query b result -> Query (HardForkBlock '[b]) a
DegenQuery (Query
   (ShelleyBlock StandardShelley)
   (Map
      (Credential 'Staking StandardShelley)
      (KeyHash 'StakePool StandardCrypto),
    RewardAccounts StandardShelley)
 -> Query
      (HardForkBlock '[ShelleyBlock StandardShelley])
      (HardForkQueryResult
         '[ShelleyBlock StandardShelley]
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
-> Query
     (ShelleyBlock StandardShelley)
     (Map
        (Credential 'Staking StandardShelley)
        (KeyHash 'StakePool StandardCrypto),
      RewardAccounts StandardShelley)
-> Query
     (HardForkBlock '[ShelleyBlock StandardShelley])
     (HardForkQueryResult
        '[ShelleyBlock StandardShelley]
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall a b. (a -> b) -> a -> b
$
                Set (Credential 'Staking StandardShelley)
-> Query
     (ShelleyBlock StandardShelley)
     (Delegations StandardShelley, RewardAccounts StandardShelley)
forall era.
Set (Credential 'Staking era)
-> Query (ShelleyBlock era) (Delegations era, RewardAccounts era)
GetFilteredDelegationsAndRewardAccounts
                  (Set StakeAddress -> Set (Credential 'Staking StandardShelley)
toShelleyStakeCredentials Set StakeAddress
stakeaddrs)
            )
      DelegationsAndRewards
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
forall (m :: * -> *) a. Monad m => a -> m a
return ((Map
   (Credential 'Staking StandardShelley)
   (KeyHash 'StakePool StandardCrypto)
 -> RewardAccounts StandardShelley -> DelegationsAndRewards)
-> (Map
      (Credential 'Staking StandardShelley)
      (KeyHash 'StakePool StandardCrypto),
    RewardAccounts StandardShelley)
-> DelegationsAndRewards
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Map
  (Credential 'Staking StandardShelley)
  (KeyHash 'StakePool StandardCrypto)
-> RewardAccounts StandardShelley -> DelegationsAndRewards
toDelegsAndRwds (Map
   (Credential 'Staking StandardShelley)
   (KeyHash 'StakePool StandardCrypto),
 RewardAccounts StandardShelley)
result)

    CardanoMode{} -> do
      Tip block
tip <- IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Tip block)
 -> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block))
-> IO (Tip block)
-> ExceptT ShelleyQueryCmdLocalStateQueryError IO (Tip block)
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo mode block -> IO (Tip block)
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo mode block
connectInfo
      CardanoQueryResult
  StandardCrypto
  (Map
     (Credential 'Staking StandardShelley)
     (KeyHash 'StakePool StandardCrypto),
   RewardAccounts StandardShelley)
result <- (AcquireFailure -> ShelleyQueryCmdLocalStateQueryError)
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult
        StandardCrypto
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult
        StandardCrypto
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AcquireFailure -> ShelleyQueryCmdLocalStateQueryError
AcquireFailureError (ExceptT
   AcquireFailure
   IO
   (CardanoQueryResult
      StandardCrypto
      (Map
         (Credential 'Staking StandardShelley)
         (KeyHash 'StakePool StandardCrypto),
       RewardAccounts StandardShelley))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult
         StandardCrypto
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
-> (IO
      (Either
         AcquireFailure
         (CardanoQueryResult
            StandardCrypto
            (Map
               (Credential 'Staking StandardShelley)
               (KeyHash 'StakePool StandardCrypto),
             RewardAccounts StandardShelley)))
    -> ExceptT
         AcquireFailure
         IO
         (CardanoQueryResult
            StandardCrypto
            (Map
               (Credential 'Staking StandardShelley)
               (KeyHash 'StakePool StandardCrypto),
             RewardAccounts StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult
           StandardCrypto
           (Map
              (Credential 'Staking StandardShelley)
              (KeyHash 'StakePool StandardCrypto),
            RewardAccounts StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult
        StandardCrypto
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     AcquireFailure
     (CardanoQueryResult
        StandardCrypto
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley)))
-> ExceptT
     AcquireFailure
     IO
     (CardanoQueryResult
        StandardCrypto
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      AcquireFailure
      (CardanoQueryResult
         StandardCrypto
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError
      IO
      (CardanoQueryResult
         StandardCrypto
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult
           StandardCrypto
           (Map
              (Credential 'Staking StandardShelley)
              (KeyHash 'StakePool StandardCrypto),
            RewardAccounts StandardShelley)))
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError
     IO
     (CardanoQueryResult
        StandardCrypto
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall a b. (a -> b) -> a -> b
$
        LocalNodeConnectInfo mode block
-> (Point block,
    Query
      block
      (CardanoQueryResult
         StandardCrypto
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
-> IO
     (Either
        AcquireFailure
        (CardanoQueryResult
           StandardCrypto
           (Map
              (Credential 'Staking StandardShelley)
              (KeyHash 'StakePool StandardCrypto),
            RewardAccounts StandardShelley)))
forall mode block result.
(ShowProxy block, ShowProxy (ApplyTxErr block),
 ShowProxy (Query block), ShowProxy (GenTx block),
 ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block
-> (Point block, Query block result)
-> IO (Either AcquireFailure result)
queryNodeLocalState
          LocalNodeConnectInfo mode block
connectInfo
          ( Tip block -> Point block
forall b. Tip b -> Point b
getTipPoint Tip block
tip
          , Query
  (ShelleyBlock StandardShelley)
  (Map
     (Credential 'Staking StandardShelley)
     (KeyHash 'StakePool StandardCrypto),
   RewardAccounts StandardShelley)
-> CardanoQuery
     StandardCrypto
     (CardanoQueryResult
        StandardCrypto
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall c a result.
(CardanoQueryResult c result ~ a) =>
Query (ShelleyBlock (ShelleyEra c)) result -> CardanoQuery c a
QueryIfCurrentShelley (Query
   (ShelleyBlock StandardShelley)
   (Map
      (Credential 'Staking StandardShelley)
      (KeyHash 'StakePool StandardCrypto),
    RewardAccounts StandardShelley)
 -> CardanoQuery
      StandardCrypto
      (CardanoQueryResult
         StandardCrypto
         (Map
            (Credential 'Staking StandardShelley)
            (KeyHash 'StakePool StandardCrypto),
          RewardAccounts StandardShelley)))
-> Query
     (ShelleyBlock StandardShelley)
     (Map
        (Credential 'Staking StandardShelley)
        (KeyHash 'StakePool StandardCrypto),
      RewardAccounts StandardShelley)
-> CardanoQuery
     StandardCrypto
     (CardanoQueryResult
        StandardCrypto
        (Map
           (Credential 'Staking StandardShelley)
           (KeyHash 'StakePool StandardCrypto),
         RewardAccounts StandardShelley))
forall a b. (a -> b) -> a -> b
$
              Set (Credential 'Staking StandardShelley)
-> Query
     (ShelleyBlock StandardShelley)
     (Delegations StandardShelley, RewardAccounts StandardShelley)
forall era.
Set (Credential 'Staking era)
-> Query (ShelleyBlock era) (Delegations era, RewardAccounts era)
GetFilteredDelegationsAndRewardAccounts
                (Set StakeAddress -> Set (Credential 'Staking StandardShelley)
toShelleyStakeCredentials Set StakeAddress
stakeaddrs)
          )
      case CardanoQueryResult
  StandardCrypto
  (Map
     (Credential 'Staking StandardShelley)
     (KeyHash 'StakePool StandardCrypto),
   RewardAccounts StandardShelley)
result of
        QueryResultEraMismatch EraMismatch
err -> ShelleyQueryCmdLocalStateQueryError
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EraMismatch -> ShelleyQueryCmdLocalStateQueryError
EraMismatchError EraMismatch
err)
        QueryResultSuccess (Map
   (Credential 'Staking StandardShelley)
   (KeyHash 'StakePool StandardCrypto),
 RewardAccounts StandardShelley)
drs -> DelegationsAndRewards
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
forall (m :: * -> *) a. Monad m => a -> m a
return (DelegationsAndRewards
 -> ExceptT
      ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards)
-> DelegationsAndRewards
-> ExceptT
     ShelleyQueryCmdLocalStateQueryError IO DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$ (Map
   (Credential 'Staking StandardShelley)
   (KeyHash 'StakePool StandardCrypto)
 -> RewardAccounts StandardShelley -> DelegationsAndRewards)
-> (Map
      (Credential 'Staking StandardShelley)
      (KeyHash 'StakePool StandardCrypto),
    RewardAccounts StandardShelley)
-> DelegationsAndRewards
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Map
  (Credential 'Staking StandardShelley)
  (KeyHash 'StakePool StandardCrypto)
-> RewardAccounts StandardShelley -> DelegationsAndRewards
toDelegsAndRwds (Map
   (Credential 'Staking StandardShelley)
   (KeyHash 'StakePool StandardCrypto),
 RewardAccounts StandardShelley)
drs
  where
    toDelegsAndRwds
      :: Map (Ledger.Credential Ledger.Staking StandardShelley)
             (Ledger.KeyHash Ledger.StakePool StandardCrypto)
      -> Ledger.RewardAccounts StandardShelley
      -> DelegationsAndRewards
    toDelegsAndRwds :: Map
  (Credential 'Staking StandardShelley)
  (KeyHash 'StakePool StandardCrypto)
-> RewardAccounts StandardShelley -> DelegationsAndRewards
toDelegsAndRwds Map
  (Credential 'Staking StandardShelley)
  (KeyHash 'StakePool StandardCrypto)
delegs RewardAccounts StandardShelley
rwdAcnts =
      NetworkId
-> Map
     (Credential 'Staking StandardShelley)
     (Maybe (Hash StakePoolKey), Coin)
-> DelegationsAndRewards
DelegationsAndRewards NetworkId
localNodeNetworkId (Map
   (Credential 'Staking StandardShelley)
   (Maybe (Hash StakePoolKey), Coin)
 -> DelegationsAndRewards)
-> Map
     (Credential 'Staking StandardShelley)
     (Maybe (Hash StakePoolKey), Coin)
-> DelegationsAndRewards
forall a b. (a -> b) -> a -> b
$
        (Credential 'Staking StandardShelley
 -> Coin -> (Maybe (Hash StakePoolKey), Coin))
-> RewardAccounts StandardShelley
-> Map
     (Credential 'Staking StandardShelley)
     (Maybe (Hash StakePoolKey), Coin)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
          (\Credential 'Staking StandardShelley
k Coin
v -> (KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey
StakePoolKeyHash (KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey)
-> Maybe (KeyHash 'StakePool StandardCrypto)
-> Maybe (Hash StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential 'Staking StandardShelley
-> Map
     (Credential 'Staking StandardShelley)
     (KeyHash 'StakePool StandardCrypto)
-> Maybe (KeyHash 'StakePool StandardCrypto)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking StandardShelley
k Map
  (Credential 'Staking StandardShelley)
  (KeyHash 'StakePool StandardCrypto)
delegs, Coin
v))
          RewardAccounts StandardShelley
rwdAcnts

    toShelleyStakeCredentials :: Set StakeAddress
                              -> Set (Ledger.StakeCredential StandardShelley)
    toShelleyStakeCredentials :: Set StakeAddress -> Set (Credential 'Staking StandardShelley)
toShelleyStakeCredentials = (StakeAddress -> Credential 'Staking StandardShelley)
-> Set StakeAddress -> Set (Credential 'Staking StandardShelley)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\(StakeAddress Network
_ Credential 'Staking StandardShelley
cred) -> Credential 'Staking StandardShelley
cred)