From c1ef66bff274afd5933206631fa342968bed46a1 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Fri, 23 Apr 2021 20:09:59 +0300 Subject: [PATCH] cardano-cli transaction view: Add friendly certificate printing --- cardano-api/src/Cardano/Api/Address.hs | 17 +- cardano-cli/src/Cardano/CLI/Run/Friendly.hs | 228 +++++++++++++----- cardano-cli/test/Test/Golden/TxView.hs | 18 +- .../data/golden/allegra/transaction-view.out | 5 +- .../data/golden/mary/transaction-view.out | 5 +- .../data/golden/shelley/transaction-view.out | 37 ++- 6 files changed, 232 insertions(+), 78 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 094fa8f2b6d..a385e91b343 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -73,18 +74,17 @@ module Cardano.Api.Address ( import Prelude -import Data.Aeson (FromJSON (..), ToJSON (..), withText) +import Control.Applicative ((<|>)) +import Data.Aeson (FromJSON (..), ToJSON (..), withText, (.=)) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Base58 as Base58 -import Data.Char +import Data.Char (isAsciiLower, isAsciiUpper, isDigit) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Text.Parsec as Parsec import qualified Text.Parsec.String as Parsec -import Control.Applicative - import qualified Cardano.Chain.Common as Byron import qualified Cardano.Ledger.Address as Shelley import qualified Cardano.Ledger.Alonzo.TxInfo as Alonzo @@ -474,6 +474,15 @@ data StakeCredential | StakeCredentialByScript ScriptHash deriving (Eq, Ord, Show) +instance ToJSON StakeCredential where + toJSON = + Aeson.object + . \case + StakeCredentialByKey keyHash -> + ["stakingKeyHash" .= serialiseToRawBytesHexText keyHash] + StakeCredentialByScript scriptHash -> + ["stakingScriptHash" .= serialiseToRawBytesHexText scriptHash] + data StakeAddressReference = StakeAddressByValue StakeCredential | StakeAddressByPointer StakeAddressPointer diff --git a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs index 96e635bb512..759e25c7ba5 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs @@ -21,10 +21,12 @@ import qualified Data.Text as Text import Data.Yaml (array) import Data.Yaml.Pretty (defConfig, encodePretty, setConfCompare) +import Cardano.Ledger.Shelley.TxBody (MIRPot (ReservesMIR, TreasuryMIR)) + import Cardano.Api as Api -import Cardano.Api.Shelley (Address (ShelleyAddress), StakeAddress (..)) -import Cardano.Ledger.Crypto (Crypto) -import qualified Cardano.Ledger.Shelley.API as Shelley +import Cardano.Api.Shelley (Address (ShelleyAddress), StakeAddress (..), + StakeCredential (..), StakePoolParameters (..), fromShelleyPaymentCredential, + fromShelleyStakeCredential, fromShelleyStakeReference) import Cardano.CLI.Helpers (textShow) @@ -90,62 +92,66 @@ friendlyValidityRange era = \case TxValidityUpperBound _ s -> toJSON s ] | otherwise -> Null - where - isLowerBoundSupported = isJust $ validityLowerBoundSupportedInEra era - isUpperBoundSupported = isJust $ validityUpperBoundSupportedInEra era + where + isLowerBoundSupported = isJust $ validityLowerBoundSupportedInEra era + isUpperBoundSupported = isJust $ validityUpperBoundSupportedInEra era friendlyWithdrawals :: TxWithdrawals ViewTx era -> Aeson.Value friendlyWithdrawals TxWithdrawalsNone = Null friendlyWithdrawals (TxWithdrawals _ withdrawals) = array - [ object - [ "address" .= serialiseAddress addr - , "network" .= net - , "credential" .= cred - , "amount" .= friendlyLovelace amount - ] - | (addr@(StakeAddress net cred), amount, _) <- withdrawals + [ object $ + "address" .= serialiseAddress addr : + "amount" .= friendlyLovelace amount : + friendlyStakeAddress addr + | (addr, amount, _) <- withdrawals ] +friendlyStakeAddress :: StakeAddress -> [(Text, Aeson.Value)] +friendlyStakeAddress (StakeAddress net cred) = + [ "network" .= net + , friendlyStakeCredential $ fromShelleyStakeCredential cred + ] + friendlyTxOut :: TxOut CtxTx era -> Aeson.Value friendlyTxOut (TxOut addr amount mdatum) = - case addr of - AddressInEra ByronAddressInAnyEra byronAdr -> - object [ "address era" .= String "Byron" - , "address" .= serialiseAddress byronAdr + object $ + case addr of + AddressInEra ByronAddressInAnyEra byronAdr -> + [ "address era" .= String "Byron" + , "address" .= serialiseAddress byronAdr + , "amount" .= friendlyTxOutValue amount + ] + AddressInEra (ShelleyAddressInEra sbe) saddr@(ShelleyAddress net cred stake) -> + let preAlonzo :: [Aeson.Pair] + preAlonzo = + friendlyPaymentCredential (fromShelleyPaymentCredential cred) : + [ "address era" .= Aeson.String "Shelley" + , "network" .= net + , "address" .= serialiseAddress saddr , "amount" .= friendlyTxOutValue amount + , "stake reference" .= + friendlyStakeReference (fromShelleyStakeReference stake) ] + datum :: ShelleyBasedEra era -> [Aeson.Pair] + datum ShelleyBasedEraShelley = [] + datum ShelleyBasedEraAllegra = [] + datum ShelleyBasedEraMary = [] + datum ShelleyBasedEraAlonzo = ["datum" .= renderDatum mdatum] + in preAlonzo ++ datum sbe + where + renderDatum :: TxOutDatum CtxTx era -> Aeson.Value + renderDatum TxOutDatumNone = Aeson.Null + renderDatum (TxOutDatumHash _ h) = + Aeson.String $ serialiseToRawBytesHexText h + renderDatum (TxOutDatum _ sData) = + scriptDataToJson ScriptDataJsonDetailedSchema sData - AddressInEra (ShelleyAddressInEra sbe) saddr@(ShelleyAddress net cred stake) -> - let preAlonzo :: [Aeson.Pair] - preAlonzo = - [ "address era" .= Aeson.String "Shelley" - , "network" .= net - , "payment credential" .= cred - , "stake reference" .= friendlyStakeReference stake - , "address" .= serialiseAddress saddr - , "amount" .= friendlyTxOutValue amount - ] - datum :: ShelleyBasedEra era -> [Aeson.Pair] - datum ShelleyBasedEraShelley = [] - datum ShelleyBasedEraAllegra = [] - datum ShelleyBasedEraMary = [] - datum ShelleyBasedEraAlonzo = ["datum" .= renderDatum mdatum] - in object $ preAlonzo ++ datum sbe - where - renderDatum :: TxOutDatum CtxTx era -> Aeson.Value - renderDatum TxOutDatumNone = Aeson.Null - renderDatum (TxOutDatumHash _ h) = - Aeson.String $ serialiseToRawBytesHexText h - renderDatum (TxOutDatum _ sData) = - scriptDataToJson ScriptDataJsonDetailedSchema sData - - -friendlyStakeReference :: Crypto crypto => Shelley.StakeReference crypto -> Aeson.Value +friendlyStakeReference :: StakeAddressReference -> Aeson.Value friendlyStakeReference = \case - Shelley.StakeRefBase cred -> toJSON cred - Shelley.StakeRefNull -> Null - Shelley.StakeRefPtr ptr -> toJSON ptr + NoStakeAddress -> Null + StakeAddressByPointer ptr -> String (show ptr) + StakeAddressByValue cred -> object [friendlyStakeCredential cred] friendlyUpdateProposal :: TxUpdateProposal era -> Aeson.Value friendlyUpdateProposal = \case @@ -155,7 +161,107 @@ friendlyUpdateProposal = \case friendlyCertificates :: TxCertificates ViewTx era -> Aeson.Value friendlyCertificates = \case TxCertificatesNone -> Null - TxCertificates _ cs _ -> toJSON $ map textShow cs + TxCertificates _ cs _ -> array $ map friendlyCertificate cs + +friendlyCertificate :: Certificate -> Aeson.Value +friendlyCertificate = + object . (:[]) . + \case + -- Stake address certificates + StakeAddressRegistrationCertificate credential -> + "stake address registration" .= + object [friendlyStakeCredential credential] + StakeAddressDeregistrationCertificate credential -> + "stake address deregistration" .= + object [friendlyStakeCredential credential] + StakeAddressDelegationCertificate credential poolId -> + "stake address delegation" .= + object [friendlyStakeCredential credential, "pool" .= poolId] + + -- Stake pool certificates + StakePoolRegistrationCertificate parameters -> + "stake pool registration" .= friendlyStakePoolParameters parameters + StakePoolRetirementCertificate poolId epochNo -> + "stake pool retirement" .= object ["pool" .= poolId, "epoch" .= epochNo] + + -- Special certificates + GenesisKeyDelegationCertificate genesisKeyHash delegateKeyHash vrfKeyHash -> + "genesis key delegation" .= + object + [ "genesis key hash" .= serialiseToRawBytesHexText genesisKeyHash + , "delegate key hash" .= serialiseToRawBytesHexText delegateKeyHash + , "VRF key hash" .= serialiseToRawBytesHexText vrfKeyHash + ] + MIRCertificate pot target -> + "MIR" .= object ["pot" .= friendlyMirPot pot, friendlyMirTarget target] + +friendlyMirTarget :: MIRTarget -> (Text, Aeson.Value) +friendlyMirTarget = \case + StakeAddressesMIR addresses -> + "target stake addresses" .= + [ object + [ friendlyStakeCredential credential + , "amount" .= friendlyLovelace lovelace + ] + | (credential, lovelace) <- addresses + ] + SendToReservesMIR amount -> "send to reserves" .= friendlyLovelace amount + SendToTreasuryMIR amount -> "send to treasury" .= friendlyLovelace amount + +friendlyStakeCredential :: StakeCredential -> (Text, Aeson.Value) +friendlyStakeCredential = \case + StakeCredentialByKey keyHash -> + "stake credential key hash" .= serialiseToRawBytesHexText keyHash + StakeCredentialByScript scriptHash -> + "stake credential script hash" .= serialiseToRawBytesHexText scriptHash + +friendlyPaymentCredential :: PaymentCredential -> (Text, Aeson.Value) +friendlyPaymentCredential = \case + PaymentCredentialByKey keyHash -> + "payment credential key hash" .= serialiseToRawBytesHexText keyHash + PaymentCredentialByScript scriptHash -> + "payment credential script hash" .= serialiseToRawBytesHexText scriptHash + +friendlyMirPot :: MIRPot -> Aeson.Value +friendlyMirPot = \case + ReservesMIR -> "reserves" + TreasuryMIR -> "treasury" + +friendlyStakePoolParameters :: StakePoolParameters -> Aeson.Value +friendlyStakePoolParameters + StakePoolParameters + { stakePoolId + , stakePoolVRF + , stakePoolCost + , stakePoolMargin + , stakePoolRewardAccount + , stakePoolPledge + , stakePoolOwners + , stakePoolRelays + , stakePoolMetadata + } = + object + [ "pool" .= stakePoolId + , "VRF key hash" .= serialiseToRawBytesHexText stakePoolVRF + , "cost" .= friendlyLovelace stakePoolCost + , "margin" .= friendlyRational stakePoolMargin + , "reward account" .= object (friendlyStakeAddress stakePoolRewardAccount) + , "pledge" .= friendlyLovelace stakePoolPledge + , "owners (stake key hashes)" + .= map serialiseToRawBytesHexText stakePoolOwners + , "relays" .= map textShow stakePoolRelays + , "metadata" .= fmap textShow stakePoolMetadata + ] + +friendlyRational :: Rational -> Aeson.Value +friendlyRational r = + String $ + case d of + 1 -> textShow n + _ -> textShow n <> "/" <> textShow d + where + n = numerator r + d = denominator r friendlyFee :: TxFee era -> Aeson.Value friendlyFee = \case @@ -184,24 +290,24 @@ friendlyValue v = friendlyPolicyId policy .= friendlyAssets assets | bundle <- bundles ] - where + where - ValueNestedRep bundles = valueToNestedRep v + ValueNestedRep bundles = valueToNestedRep v - friendlyPolicyId = ("policy " <>) . serialiseToRawBytesHexText + friendlyPolicyId = ("policy " <>) . serialiseToRawBytesHexText - friendlyAssets = Map.mapKeys friendlyAssetName + friendlyAssets = Map.mapKeys friendlyAssetName - friendlyAssetName = \case - "" -> "default asset" - name@(AssetName nameBS) -> - "asset " <> serialiseToRawBytesHexText name <> nameAsciiSuffix - where - nameAsciiSuffix - | nameIsAscii = " (" <> nameAscii <> ")" - | otherwise = "" - nameIsAscii = BSC.all (\c -> isAscii c && isAlphaNum c) nameBS - nameAscii = Text.pack $ BSC.unpack nameBS + friendlyAssetName = \case + "" -> "default asset" + name@(AssetName nameBS) -> + "asset " <> serialiseToRawBytesHexText name <> nameAsciiSuffix + where + nameAsciiSuffix + | nameIsAscii = " (" <> nameAscii <> ")" + | otherwise = "" + nameIsAscii = BSC.all (\c -> isAscii c && isAlphaNum c) nameBS + nameAscii = Text.pack $ BSC.unpack nameBS friendlyMetadata :: TxMetadataInEra era -> Aeson.Value friendlyMetadata = \case diff --git a/cardano-cli/test/Test/Golden/TxView.hs b/cardano-cli/test/Test/Golden/TxView.hs index e8da8252e2d..92d91c86e66 100644 --- a/cardano-cli/test/Test/Golden/TxView.hs +++ b/cardano-cli/test/Test/Golden/TxView.hs @@ -6,6 +6,7 @@ import Cardano.Prelude import Hedgehog (Group (..), Property, checkSequential) import Hedgehog.Extras.Test.Base (moduleWorkspace, propertyOnce) +import System.FilePath (()) import Test.OptParse (execCardanoCLI, noteTempFile) import Test.Utilities (diffVsGoldenFile) @@ -50,14 +51,25 @@ golden_view_byron = diffVsGoldenFile result "test/data/golden/byron/transaction-view.out" golden_view_shelley :: Property -golden_view_shelley = +golden_view_shelley = let + certDir = "test/data/golden/shelley/certificates" + certs = + (certDir ) <$> + [ "genesis_key_delegation_certificate" + , "mir_certificate" + , "stake_address_deregistration_certificate" + , "stake_address_registration_certificate" + , "stake_pool_deregistration_certificate" + , "stake_pool_registration_certificate" + ] + in propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do transactionBodyFile <- noteTempFile tempDir "transaction-body-file" -- Create transaction body void $ - execCardanoCLI + execCardanoCLI $ [ "transaction", "build-raw" , "--shelley-era" , "--tx-in" @@ -72,6 +84,8 @@ golden_view_shelley = \+42" , "--out-file", transactionBodyFile ] + ++ + ["--certificate-file=" <> cert | cert <- certs] -- View transaction body result <- diff --git a/cardano-cli/test/data/golden/allegra/transaction-view.out b/cardano-cli/test/data/golden/allegra/transaction-view.out index a46d59039ec..80b4e873548 100644 --- a/cardano-cli/test/data/golden/allegra/transaction-view.out +++ b/cardano-cli/test/data/golden/allegra/transaction-view.out @@ -11,10 +11,9 @@ outputs: address era: Shelley amount: 99 Lovelace network: Testnet - payment credential: - key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 + payment credential key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 stake reference: - key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 + stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 update proposal: null validity range: lower bound: null diff --git a/cardano-cli/test/data/golden/mary/transaction-view.out b/cardano-cli/test/data/golden/mary/transaction-view.out index ce511acec9e..089e1c9cd70 100644 --- a/cardano-cli/test/data/golden/mary/transaction-view.out +++ b/cardano-cli/test/data/golden/mary/transaction-view.out @@ -28,10 +28,9 @@ outputs: asset f00d: 134 default asset: 130 network: Testnet - payment credential: - key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 + payment credential key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 stake reference: - key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 + stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 update proposal: null validity range: lower bound: 140 diff --git a/cardano-cli/test/data/golden/shelley/transaction-view.out b/cardano-cli/test/data/golden/shelley/transaction-view.out index e655f683aa5..8a02c5beb5d 100644 --- a/cardano-cli/test/data/golden/shelley/transaction-view.out +++ b/cardano-cli/test/data/golden/shelley/transaction-view.out @@ -1,5 +1,34 @@ auxiliary scripts: null -certificates: null +certificates: +- genesis key delegation: + VRF key hash: 1b9de69baec0dff8dde6e81d71f40f8b65fb3df55bb6ece5783aade88b17354d + delegate key hash: d52ac434259f2af7fd2a538ece5ef8d80386527aa93e207473acb31c + genesis key hash: c3db461200fa59c81a4ecc8495446d9e42de27483ff6ee4339c9ab94 +- MIR: + pot: reserves + target stake addresses: + - amount: 1000 Lovelace + stake credential key hash: ee475cade27e95faf1093541b0783498016cdcfba0d6441055b2dfcb +- stake address deregistration: + stake credential key hash: d0efd9836e62225a47baf9bedfeaccbb86ba3f49d9edc4ac0aa26df5 +- stake address registration: + stake credential key hash: c6ea7e348d300b32798888497290db24a99a36f2238ed9668f602d7a +- stake pool retirement: + epoch: 42 + pool: pool13lllruv6rd63l70vkpgye2ea856f22k8xhujmf2vvlul5ytw7mx +- stake pool registration: + VRF key hash: 8d445260282cef45e4c6a862b8a924aeed1b316ccba779dd39f9517220e96407 + cost: 1000 Lovelace + margin: 1/10 + metadata: null + owners (stake key hashes): + - f25fc5c9f341ec3bd785ddea746f76b6a9ac7f38fdd7aef1779bbe81 + pledge: 5000 Lovelace + pool: pool1cxxj569g3x9akwv49vv6u5z8d3l7xrwzh7p2tf2g2ajkce894m3 + relays: [] + reward account: + network: Mainnet + stake credential key hash: f25fc5c9f341ec3bd785ddea746f76b6a9ac7f38fdd7aef1779bbe81 era: Shelley fee: 32 Lovelace inputs: @@ -11,8 +40,7 @@ outputs: address era: Shelley amount: 31 Lovelace network: Testnet - payment credential: - key hash: bce78cb90f6da9ee778ef07ca881b489c38a188993e6870bd5a9ef77 + payment credential key hash: bce78cb90f6da9ee778ef07ca881b489c38a188993e6870bd5a9ef77 stake reference: null update proposal: null validity range: @@ -20,6 +48,5 @@ validity range: withdrawals: - address: stake_test1up00fz9lyqs5sjks82k22eqz7a9srym9vysjgp3h2ua2v2cm522kg amount: 42 Lovelace - credential: - key hash: 5ef488bf2021484ad03aaca56402f74b0193656121240637573aa62b network: Testnet + stake credential key hash: 5ef488bf2021484ad03aaca56402f74b0193656121240637573aa62b