Skip to content

Commit

Permalink
Merge pull request #452 from input-output-hk/ch/show-vote-delegation
Browse files Browse the repository at this point in the history
Show vote delegation in `stake-address-info`
  • Loading branch information
carlhammann authored Nov 23, 2023
2 parents ca5392f + 1b21c7e commit c2de167
Showing 1 changed file with 23 additions and 5 deletions.
28 changes: 23 additions & 5 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@ module Cardano.CLI.EraBased.Run.Query
import Cardano.Api hiding (QueryInShelleyBasedEra (..))
import qualified Cardano.Api as Api
import Cardano.Api.Byron hiding (QueryInShelleyBasedEra (..))
import qualified Cardano.Api.Ledger as L
import qualified Cardano.Api.Ledger as Ledger
import Cardano.Api.Pretty
import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
Expand All @@ -57,6 +58,7 @@ import Cardano.Crypto.Hash (hashToBytesAsHex)
import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
import qualified Cardano.Ledger.BaseTypes as L
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Credential as L
import qualified Cardano.Ledger.Crypto as Crypto
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.SafeHash (SafeHash)
Expand Down Expand Up @@ -812,11 +814,16 @@ runQueryStakeAddressInfoCmd
& onLeft (left . QueryCmdUnsupportedNtcVersion)
& onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)

stakeVoteDelegatees <- lift (queryStakeVoteDelegatees sbe stakeAddr)
& onLeft (left . QueryCmdUnsupportedNtcVersion)
& onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)

return $ do
writeStakeAddressInfo
mOutFile
(DelegationsAndRewards (stakeRewardAccountBalances, stakePools))
(Map.mapKeys (makeStakeAddress networkId) stakeDelegDeposits)
(Map.mapKeys (makeStakeAddress networkId) stakeVoteDelegatees)
)
& onLeft (left . QueryCmdAcquireFailure)
& onLeft left
Expand All @@ -827,37 +834,48 @@ writeStakeAddressInfo
:: Maybe (File () Out)
-> DelegationsAndRewards
-> Map StakeAddress Lovelace -- ^ deposits
-> Map StakeAddress (L.DRep L.StandardCrypto) -- ^ vote delegatees
-> ExceptT QueryCmdError IO ()
writeStakeAddressInfo
mOutFile
(DelegationsAndRewards (stakeAccountBalances, stakePools))
stakeDelegDeposits =
stakeDelegDeposits
voteDelegatees =
firstExceptT QueryCmdWriteFileError . newExceptT
$ writeLazyByteStringOutput mOutFile (encodePretty jsonInfo)
where
jsonInfo :: [Aeson.Value]
jsonInfo =
map
(\(addr, mBalance, mPoolId, mDeposit) ->
(\(addr, mBalance, mPoolId, mDRep, mDeposit) ->
Aeson.object
[ "address" .= addr
, "delegation" .= mPoolId
, "stakeDelegation" .= mPoolId
, "voteDelegation" .= fmap friendlyDRep mDRep
, "rewardAccountBalance" .= mBalance
, "delegationDeposit" .= mDeposit
]
)
merged

merged :: [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe Lovelace)]
friendlyDRep :: L.DRep L.StandardCrypto -> Text
friendlyDRep L.DRepAlwaysAbstain = "alwaysAbstain"
friendlyDRep L.DRepAlwaysNoConfidence = "alwaysNoConfidence"
friendlyDRep (L.DRepCredential cred) =
L.credToText cred -- this will pring "keyHash-..." or "scriptHash-...", depending on the type of credential

merged :: [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe (L.DRep L.StandardCrypto), Maybe Lovelace)]
merged =
[ (addr, mBalance, mPoolId, mDeposit)
[ (addr, mBalance, mPoolId, mDRep, mDeposit)
| addr <- Set.toList (Set.unions [ Map.keysSet stakeAccountBalances
, Map.keysSet stakePools
, Map.keysSet stakeDelegDeposits
, Map.keysSet voteDelegatees
])
, let mBalance = Map.lookup addr stakeAccountBalances
mPoolId = Map.lookup addr stakePools
mDeposit = Map.lookup addr stakeDelegDeposits
mDRep = Map.lookup addr voteDelegatees
]

writeLedgerState :: forall era ledgerera.
Expand Down

0 comments on commit c2de167

Please sign in to comment.