From d2f214e4974d19fa6788cf99a4243f0a55ace0f2 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 15 Apr 2021 16:15:01 +1000 Subject: [PATCH] Tidy up coding style. Use hoistMaybe to flatten code. Reduce use of where clauses, especially nested where clauses. Add documentation. --- .../src/Cardano/CLI/Shelley/Parsers.hs | 45 ++-- .../src/Cardano/CLI/Shelley/Run/Query.hs | 208 +++++++----------- cardano-cli/src/Cardano/CLI/Types.hs | 69 ++++-- doc/index.rst | 1 + doc/reference/cardano-node-cli-reference.md | 6 +- doc/stake-pool-operations/query_stakepool.md | 112 ++++++++++ 6 files changed, 265 insertions(+), 176 deletions(-) create mode 100644 doc/stake-pool-operations/query_stakepool.md diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 6fdb986cf30..4ff3cc89922 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -690,11 +690,10 @@ pQueryCmd = <*> pMaybeOutputFile pQueryTip :: Parser QueryCmd - pQueryTip = - QueryTip - <$> pConsensusModeParams - <*> pNetworkId - <*> pMaybeOutputFile + pQueryTip = QueryTip + <$> pConsensusModeParams + <*> pNetworkId + <*> pMaybeOutputFile pQueryUTxO :: Parser QueryCmd pQueryUTxO = @@ -720,32 +719,28 @@ pQueryCmd = <*> pMaybeOutputFile pQueryLedgerState :: Parser QueryCmd - pQueryLedgerState = - QueryLedgerState' - <$> pConsensusModeParams - <*> pNetworkId - <*> pMaybeOutputFile + pQueryLedgerState = QueryLedgerState' + <$> pConsensusModeParams + <*> pNetworkId + <*> pMaybeOutputFile pQueryProtocolState :: Parser QueryCmd - pQueryProtocolState = - QueryProtocolState' - <$> pConsensusModeParams - <*> pNetworkId - <*> pMaybeOutputFile + pQueryProtocolState = QueryProtocolState' + <$> pConsensusModeParams + <*> pNetworkId + <*> pMaybeOutputFile pQueryStakeSnapshot :: Parser QueryCmd - pQueryStakeSnapshot = - QueryStakeSnapshot' - <$> pConsensusModeParams - <*> pNetworkId - <*> pStakePoolVerificationKeyHash + pQueryStakeSnapshot = QueryStakeSnapshot' + <$> pConsensusModeParams + <*> pNetworkId + <*> pStakePoolVerificationKeyHash pQueryPoolParams :: Parser QueryCmd - pQueryPoolParams = - QueryPoolParams' - <$> pConsensusModeParams - <*> pNetworkId - <*> pStakePoolVerificationKeyHash + pQueryPoolParams = QueryPoolParams' + <$> pConsensusModeParams + <*> pNetworkId + <*> pStakePoolVerificationKeyHash pGovernanceCmd :: Parser GovernanceCmd diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index 4d1c33656f9..020b0900ca3 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -24,7 +24,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.HashMap.Strict as HMS import Data.List (nub) import qualified Data.Map.Strict as Map -import Data.Maybe import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Text.Encoding as Text @@ -256,8 +255,7 @@ runQueryPoolParams -> NetworkId -> Hash StakePoolKey -> ExceptT ShelleyQueryCmdError IO () -runQueryPoolParams (AnyConsensusModeParams cModeParams) - network poolid = do +runQueryPoolParams (AnyConsensusModeParams cModeParams) network poolid = do SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath @@ -265,32 +263,23 @@ runQueryPoolParams (AnyConsensusModeParams cModeParams) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era - case toEraInMode era cMode of - Just eInMode -> do - let qInMode = QueryInEra eInMode - . QueryInShelleyBasedEra sbe - $ QueryLedgerState - result <- executeQuery - era - cModeParams - localNodeConnInfo - qInMode - obtainLedgerEraClassConstraints sbe (writePoolParams poolid) result - Nothing -> left . ShelleyQueryCmdEraConsensusModeMismatch anyE $ AnyConsensusMode cMode + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch anyE (AnyConsensusMode cMode)) + + let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryLedgerState + result <- executeQuery era cModeParams localNodeConnInfo qInMode + obtainLedgerEraClassConstraints sbe (writePoolParams poolid) result -- | Obtain stake snapshot information for a pool, plus information about the total active stake. -- This information can be used for leader slot calculation, for example, and has been requested by SPOs. -- Obtaining the information directly is significantly more time and memory efficient than using a full ledger state dump. --- - runQueryStakeSnapshot :: AnyConsensusModeParams -> NetworkId -> Hash StakePoolKey -> ExceptT ShelleyQueryCmdError IO () -runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) - network poolid = do +runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network poolid = do SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath @@ -298,18 +287,12 @@ runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era - case toEraInMode era cMode of - Just eInMode -> do - let qInMode = QueryInEra eInMode - . QueryInShelleyBasedEra sbe - $ QueryLedgerState - result <- executeQuery - era - cModeParams - localNodeConnInfo - qInMode - obtainLedgerEraClassConstraints sbe (writeStakeSnapshot poolid) result - Nothing -> left . ShelleyQueryCmdEraConsensusModeMismatch anyE $ AnyConsensusMode cMode + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch anyE (AnyConsensusMode cMode)) + + let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryLedgerState + result <- executeQuery era cModeParams localNodeConnInfo qInMode + obtainLedgerEraClassConstraints sbe (writeStakeSnapshot poolid) result runQueryLedgerState @@ -453,111 +436,86 @@ writeLedgerState mOutFile qState@(SerialisedLedgerState serLedgerState) = handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) $ LBS.writeFile fpath $ unSerialised serLedgerState -writeStakeSnapshot :: forall era ledgerera. - ShelleyLedgerEra era ~ ledgerera - => Era.Era ledgerera - => FromCBOR (LedgerState era) - => Hash StakePoolKey - -> SerialisedLedgerState era - -> ExceptT ShelleyQueryCmdError IO () - +writeStakeSnapshot :: forall era ledgerera. () + => ShelleyLedgerEra era ~ ledgerera + => Era.Era ledgerera + => FromCBOR (LedgerState era) + => Hash StakePoolKey + -> SerialisedLedgerState era + -> ExceptT ShelleyQueryCmdError IO () writeStakeSnapshot poolId qState = case decodeLedgerState qState of + -- In the event of decode failure print the CBOR instead Left bs -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs - Right ledgerState -> - if isNothing maybehk then - left $ ShelleyQueryCmdPoolIdError poolId - else - liftIO . LBS.putStrLn $ encodePretty $ - Stakes { markpool = markStake - , setpool = setStake - , gopool = goStake - , marktot = markTotal - , settot = setTotal - , gotot = goTotal - } - where - -- Ledger State - (LedgerState snapshot) = ledgerState - - -- The three stake snapshots, obtained from the ledger state - (SnapShots markS setS goS _) = esSnapshots $ nesEs snapshot - - - -- Calculate the three pool and active stake values for the given pool - markStake = getPoolStake hk markS - setStake = getPoolStake hk setS - goStake = getPoolStake hk goS - - markTotal = getAllStake markS - setTotal = getAllStake setS - goTotal = getAllStake goS - - -- Convert the hash string into a KeyHash for use by the ledger - maybehk = hashFromStringAsHex $ filter (/= '"') $ show poolId - hk = KeyHash $ fromJust maybehk - - -- Sum all the stake that is held by the pool - getPoolStake :: KeyHash Shelley.Spec.Ledger.Keys.StakePool crypto - -> SnapShot crypto - -> Integer - getPoolStake hash ss = pStake - where - Coin pStake = fold s - (Stake s) = poolStake hash (_delegations ss) (_stake ss) - - -- Sum the active stake from a snapshot - getAllStake :: SnapShot crypto - -> Integer - getAllStake (SnapShot stake _ _) = activeStake - where - Coin activeStake = fold . unStake $ stake + + Right ledgerState -> do + -- Convert the hash string into a KeyHash for use by the ledger + hk <- KeyHash <$> hashFromStringAsHex (filter (/= '"') (show poolId)) + & hoistMaybe (ShelleyQueryCmdPoolIdError poolId) + + -- Ledger State + let (LedgerState snapshot) = ledgerState + + -- The three stake snapshots, obtained from the ledger state + let (SnapShots markS setS goS _) = esSnapshots $ nesEs snapshot + + -- Calculate the three pool and active stake values for the given pool + liftIO . LBS.putStrLn $ encodePretty $ Stakes + { markPool = getPoolStake hk markS + , setPool = getPoolStake hk setS + , goPool = getPoolStake hk goS + , markTotal = getAllStake markS + , setTotal = getAllStake setS + , goTotal = getAllStake goS + } + +-- | Sum all the stake that is held by the pool +getPoolStake :: KeyHash Shelley.Spec.Ledger.Keys.StakePool crypto -> SnapShot crypto -> Integer +getPoolStake hash ss = pStake + where + Coin pStake = fold s + (Stake s) = poolStake hash (_delegations ss) (_stake ss) + +-- | Sum the active stake from a snapshot +getAllStake :: SnapShot crypto -> Integer +getAllStake (SnapShot stake _ _) = activeStake + where + Coin activeStake = fold . unStake $ stake -- | This function obtains the pool parameters, equivalent to the following jq query on the output of query ledger-state -- .nesEs.esLState._delegationState._pstate._pParams. -writePoolParams :: forall era ledgerera. - ShelleyLedgerEra era ~ ledgerera - => FromCBOR (LedgerState era) - => Crypto.Crypto (Era.Crypto ledgerera) - => Hash StakePoolKey - -> SerialisedLedgerState era - -> ExceptT ShelleyQueryCmdError IO () +writePoolParams :: forall era ledgerera. () + => ShelleyLedgerEra era ~ ledgerera + => FromCBOR (LedgerState era) + => Crypto.Crypto (Era.Crypto ledgerera) + => Hash StakePoolKey + -> SerialisedLedgerState era + -> ExceptT ShelleyQueryCmdError IO () writePoolParams poolId qState = case decodeLedgerState qState of + -- In the event of decode failure print the CBOR instead Left bs -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs - Right ledgerState -> - if isNothing maybehk then - left $ ShelleyQueryCmdPoolIdError poolId - else - liftIO . LBS.putStrLn $ encodePretty $ Params poolparams fpoolparams retiring - where - (LedgerState snapshot) = ledgerState - - -- pool state - ps = _pstate $ _delegationState $ esLState $ nesEs snapshot - - -- Convert the hash string into a KeyHash for use by the ledger - maybehk = hashFromStringAsHex $ filter (/= '"') $ show poolId - hk = KeyHash $ fromJust maybehk - - -- pool parameters - poolparams = getPoolParams hk $ _pParams ps - fpoolparams = getPoolParams hk $ _fPParams ps - retiring = getPoolParams hk $ _retiring ps - - - getPoolParams :: KeyHash StakePool (Era.Crypto ledgerera) - -> Map (KeyHash StakePool (Era.Crypto ledgerera)) params - -> Maybe params - getPoolParams poolid poolparammap = Map.lookup poolid poolparammap - -decodeLedgerState :: - forall era. - FromCBOR (LedgerState era) + + Right ledgerState -> do + let LedgerState snapshot = ledgerState + let poolState = _pstate $ _delegationState $ esLState $ nesEs snapshot + + -- Convert the hash string into a KeyHash for use by the ledger + hk <- KeyHash <$> hashFromStringAsHex (filter (/= '"') (show poolId)) + & hoistMaybe (ShelleyQueryCmdPoolIdError poolId) + + -- Pool parameters + let poolParams = Map.lookup hk $ _pParams poolState + let fPoolParams = Map.lookup hk $ _fPParams poolState + let retiring = Map.lookup hk $ _retiring poolState + + liftIO . LBS.putStrLn $ encodePretty $ Params poolParams fPoolParams retiring + +decodeLedgerState :: forall era. () + => FromCBOR (LedgerState era) => SerialisedLedgerState era -> Either LBS.ByteString (LedgerState era) -decodeLedgerState (SerialisedLedgerState (Serialised ls)) = - first (const ls) (decodeFull ls) +decodeLedgerState (SerialisedLedgerState (Serialised ls)) = first (const ls) (decodeFull ls) writeProtocolState :: Crypto.Crypto StandardCrypto => Maybe OutputFile diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs index 2436902688e..ccf595f7e9b 100644 --- a/cardano-cli/src/Cardano/CLI/Types.hs +++ b/cardano-cli/src/Cardano/CLI/Types.hs @@ -71,40 +71,63 @@ data QueryFilter deriving (Eq, Show) -- | This data structure is used to allow nicely formatted output within the query stake-snapshot command. --- "markpool", "setpool", "gopool" are the three ledger state stake snapshots (most recent to least recent) +-- +-- "markPool", "setPool", "goPool" are the three ledger state stake snapshots (from most recent to least recent) -- go is the snapshot that is used for the current epoch, set will be used in the next epoch, --- mark for the epoch after that. "marktot", "setttot", "gotot" record the total active stake for each snapshot --- This information can be used by community tools to calculate upcoming leader schedules -data Stakes = Stakes { - markpool, setpool, gopool :: Integer, - marktot, settot, gotot :: Integer - } deriving Show +-- mark for the epoch after that. "markTotal", "setTotal", "goTotal" record the total active stake for each snapshot. +-- +-- This information can be used by community tools to calculate upcoming leader schedules. +data Stakes = Stakes + { markPool :: Integer + , setPool :: Integer + , goPool :: Integer + , markTotal :: Integer + , setTotal :: Integer + , goTotal :: Integer + } deriving Show -- | Pretty printing for stake information instance ToJSON Stakes where - toJSON (Stakes m s g mt st gt) = - object [ "poolStakeMark" .= m, "poolStakeSet" .= s, "poolStakeGo" .= g, - "activeStakeMark" .= mt, "activeStakeSet" .= st, "activeStakeGo" .= gt ] - - toEncoding (Stakes m s g mt st gt) = - pairs ( "poolStakeMark" .= m <> "poolStakeSet" .= s <> "poolStakeGo" .= g <> - "activeStakeMark" .= mt <> "activeStakeSet" .= st <> "activeStakeGo" .= gt ) + toJSON (Stakes m s g mt st gt) = object + [ "poolStakeMark" .= m + , "poolStakeSet" .= s + , "poolStakeGo" .= g + , "activeStakeMark" .= mt + , "activeStakeSet" .= st + , "activeStakeGo" .= gt + ] + + toEncoding (Stakes m s g mt st gt) = pairs $ mconcat + [ "poolStakeMark" .= m + , "poolStakeSet" .= s + , "poolStakeGo" .= g + , "activeStakeMark" .= mt + , "activeStakeSet" .= st + , "activeStakeGo" .= gt + ] -- | This data structure is used to allow nicely formatted output in the query pool-params command. -- params are the current pool parameter settings, futureparams are new parameters, retiringEpoch is the --- epoch that has been set for pool retirement. Any of these may be Nothing -data Params crypto = Params { - poolparameters, futurepoolparameters :: Maybe (PoolParams crypto), - retiringEpoch :: Maybe EpochNo +-- epoch that has been set for pool retirement. Any of these may be Nothing. +data Params crypto = Params + { poolParameters :: Maybe (PoolParams crypto) + , futurePoolParameters :: Maybe (PoolParams crypto) + , retiringEpoch :: Maybe EpochNo } deriving Show -- | Pretty printing for pool parameters instance Crypto.Crypto crypto => ToJSON (Params crypto) where - toJSON (Params p fp r) = - object ["poolParams" .= p, "futurePoolParams" .= fp, "retiring" .= r] - - toEncoding (Params p fp r) = - pairs ("poolParams" .= p <> "futurePoolParams" .= fp <> "retiring" .= r) + toJSON (Params p fp r) = object + [ "poolParams" .= p + , "futurePoolParams" .= fp + , "retiring" .= r + ] + + toEncoding (Params p fp r) = pairs $ mconcat + [ "poolParams" .= p + , "futurePoolParams" .= fp + , "retiring" .= r + ] newtype SigningKeyFile = SigningKeyFile { unSigningKeyFile :: FilePath } diff --git a/doc/index.rst b/doc/index.rst index 93836cf3fa0..242f7b5f21e 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -37,6 +37,7 @@ cardano-node stake-pool-operations/KES_period stake-pool-operations/core_relay stake-pool-operations/register_stakepool + stake-pool-operations/query_stakepool stake-pool-operations/start_your_nodes stake-pool-operations/withdraw-rewards stake-pool-operations/retire_stakepool diff --git a/doc/reference/cardano-node-cli-reference.md b/doc/reference/cardano-node-cli-reference.md index 21812fbc0ae..a1b2ad739c7 100644 --- a/doc/reference/cardano-node-cli-reference.md +++ b/doc/reference/cardano-node-cli-reference.md @@ -61,14 +61,14 @@ The `stake-pool` command contains the following sub commands: *cardano-cli query* The `query` command contains the following sub commands: -* `protocol-parameters`(advanced): retrieves the node’s current pool parameters (a raw dump of `Ledger.ChainDepState`). This +* `protocol-parameters` (advanced): retrieves the node’s current pool parameters (a raw dump of `Ledger.ChainDepState`). This * `tip`: gets the node’s current tip (slot number, hash, and block number) * `utxo`: retrieves the node’s current UTxO, filtered by address * `ledger-state` (advanced): dumps the current state of the node (a raw dump of `Ledger.NewEpochState`) * `stake-address-info`: Get the current delegations and reward accounts filtered by stake address. * `stake-distribution`: Get the node's current aggregated stake distribution -* 'stake-snapshot': Get the stake snapshot information for a stake pool (advanced) -* 'pool-params': Get the current and future parameters for a stake pool (advanced) +* `stake-snapshot` (advanced): Get the stake snapshot information for a stake pool +* `pool-params` (advanced): Get the current and future parameters for a stake pool *cardano-cli governance* The `governance` command contains the following sub commands: diff --git a/doc/stake-pool-operations/query_stakepool.md b/doc/stake-pool-operations/query_stakepool.md new file mode 100644 index 00000000000..7eb5479ea31 --- /dev/null +++ b/doc/stake-pool-operations/query_stakepool.md @@ -0,0 +1,112 @@ +# Querying a Stake Pool + +Two queries are available for querying your stakepool: + +* `stake-snapshot` (advanced): Get the stake snapshot information for a stake pool +* `pool-params` (advanced): Get the current and future parameters for a stake pool, + including retirement + +## Querying for stake snapshot + +The stake snapshot returns information about the mark, set, go ledger snapshots for a pool, plus +the total active stake for each snapshot that can be used in a 'sigma' calculation: + +```bash +$ cardano-cli query stake-snapshot \ + --stake-pool-id 00beef0a9be2f6d897ed24a613cf547bb20cd282a04edfc53d477114 \ + --mainnet +{ + "poolStakeGo": 40278547538358, + "activeStakeGo": 22753958467474959, + "poolStakeMark": 40424218559492, + "activeStakeMark": 22670949084364797, + "poolStakeSet": 39898761956772, + "activeStakeSet": 22488877070796904 +} +``` + +Each snapshot is taken at the end of a different era. The `go` snapshot is the current one and +was taken two epochs earlier, `set` was taken one epoch ago, and `mark` was taken immediately +before the start of the current epoch. + +This command if for debugging purposes only and may fail when used in a memory constrained +environment due to the size of the ledger state. + +# Querying for pool pparameters + +The pool parameters command returns three pieces of information: current parameters, future +parameters and retiring information. + +They may be `null` if eg the parameters are not changing. + +```bash +$ cardano-cli query pool-params \ + --stake-pool-id d785ff6a030ae9d521770c00f264a2aa423e928c85fc620b13d46eda \ + --mainnet +{ + "poolParams": { + "publicKey": "d785ff6a030ae9d521770c00f264a2aa423e928c85fc620b13d46eda", + "cost": 340000000, + "metadata": { + "hash": "b150b12a1301c4b1510ac8b9f53f7571cabb43455f6fd244cd8fd97504b1c869", + "url": "https://adalite.io/ADLT4-metadata.json" + }, + "owners": [ + "463a9695c9222183ee6e1523478722bebcb332fa3769f1d8ef40c7d0", + "5049c1dac0e597ee902f27a74a167cf135ae7c1717b0d3a417cd6c67" + ], + "vrf": "0a21e37b1917ce37a897eb2a8dc6715973a18d0586f7ab4962e3975561151348", + "pledge": 30000000000, + "margin": 3.0e-2, + "rewardAccount": { + "network": "Mainnet", + "credential": { + "key hash": "b1bc146a5fb0683c4e3836712d115b98619048bc307cc059b6adc76e" + } + }, + "relays": [ + { + "single host address": { + "IPv6": null, + "port": 3003, + "IPv4": "54.228.75.154" + } + }, + { + "single host address": { + "IPv6": null, + "port": 3001, + "IPv4": "54.228.75.154" + } + }, + { + "single host address": { + "IPv6": null, + "port": 3003, + "IPv4": "34.249.11.89" + } + }, + { + "single host address": { + "IPv6": null, + "port": 3001, + "IPv4": "34.249.11.89" + } + } + ] + }, + "futurePoolParams": null, + "retiring": null +} +``` + +The main advantage of these commands over using `query ledger-state` is that they avoid the need +to dump the full ledger state (which is both time consuming and memory intensive - meaning they +reduce the total system demands for SPOs), and will make it easier to support CNCLI and other +tools. + +They also use existing internal operations (such as the ledger pool stake and active stake +calculations), meaning that the information is guaranteed to be identical to that which the +ledger is using (and without having to write scripts to extract/correlate the information). + +This command if for debugging purposes only.