diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index c0dc750c66e..561a2e1e1c7 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 #-} @@ -75,18 +76,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 @@ -482,6 +482,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 ef78aae3dd6..e9cdda87103 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs @@ -10,14 +10,8 @@ -- | User-friendly pretty-printing for textual user interfaces (TUI) module Cardano.CLI.Run.Friendly (friendlyTxBS, friendlyTxBodyBS) where -import Cardano.Api as Api -import Cardano.Api.Byron (KeyWitness (ByronKeyWitness)) -import Cardano.Api.Shelley (Address (ShelleyAddress), - KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..)) -import Cardano.CLI.Helpers (textShow) -import Cardano.Ledger.Crypto (Crypto) -import qualified Cardano.Ledger.Shelley.API as Shelley import Cardano.Prelude + import Data.Aeson (Value (..), object, toJSON, (.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as Aeson @@ -29,13 +23,22 @@ import Data.Yaml (array) import Data.Yaml.Pretty (setConfCompare) import qualified Data.Yaml.Pretty as Yaml +import Cardano.Api as Api +import Cardano.Api.Byron (KeyWitness (ByronKeyWitness)) +import Cardano.Api.Shelley (Address (ShelleyAddress), + KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..), + StakeCredential (..), StakePoolParameters (..), fromShelleyPaymentCredential, + fromShelleyStakeCredential, fromShelleyStakeReference) +import Cardano.CLI.Helpers (textShow) +import qualified Cardano.Ledger.Shelley.API as Shelley + yamlConfig :: Yaml.Config yamlConfig = Yaml.defConfig & setConfCompare compare -friendlyTxBS :: CardanoEra era -> Tx era -> ByteString +friendlyTxBS :: IsCardanoEra era => CardanoEra era -> Tx era -> ByteString friendlyTxBS era = Yaml.encodePretty yamlConfig . object . friendlyTx era -friendlyTx :: CardanoEra era -> Tx era -> [Aeson.Pair] +friendlyTx :: IsCardanoEra era => CardanoEra era -> Tx era -> [Aeson.Pair] friendlyTx era (Tx body witnesses) = ("witnesses" .= map friendlyKeyWitness witnesses) : friendlyTxBody era body @@ -49,11 +52,13 @@ friendlyKeyWitness = ShelleyKeyWitness _era (Shelley.WitVKey key signature) -> ["key" .= textShow key, "signature" .= textShow signature] -friendlyTxBodyBS :: CardanoEra era -> TxBody era -> ByteString +friendlyTxBodyBS + :: IsCardanoEra era => CardanoEra era -> TxBody era -> ByteString friendlyTxBodyBS era = Yaml.encodePretty yamlConfig . object . friendlyTxBody era -friendlyTxBody :: CardanoEra era -> TxBody era -> [Aeson.Pair] +friendlyTxBody + :: IsCardanoEra era => CardanoEra era -> TxBody era -> [Aeson.Pair] friendlyTxBody era (TxBody @@ -121,64 +126,68 @@ 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 ] --- TODO: Babbage era -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 +friendlyStakeAddress :: StakeAddress -> [Aeson.Pair] +friendlyStakeAddress (StakeAddress net cred) = + [ "network" .= net + , friendlyStakeCredential $ fromShelleyStakeCredential cred + ] + +friendlyTxOut :: IsCardanoEra era => TxOut CtxTx era -> Aeson.Value +friendlyTxOut (TxOut addr amount mdatum script) = + 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 = + friendlyPaymentCredential (fromShelleyPaymentCredential cred) : + [ "address era" .= Aeson.String "Shelley" + , "network" .= net + , "address" .= serialiseAddress saddr , "amount" .= friendlyTxOutValue amount + , "stake reference" .= + friendlyStakeReference (fromShelleyStakeReference stake) ] - - 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] - datum ShelleyBasedEraBabbage = panic "TODO: Babbage" - in object $ preAlonzo ++ datum sbe - where - renderDatum :: TxOutDatum CtxTx era -> Aeson.Value - renderDatum TxOutDatumNone = Aeson.Null - renderDatum (TxOutDatumHash _ h) = - Aeson.String $ serialiseToRawBytesHexText h - renderDatum (TxOutDatumInTx _ sData) = - scriptDataToJson ScriptDataJsonDetailedSchema sData - renderDatum (TxOutDatumInline _ _) = panic "TODO: Babbage" - -friendlyStakeReference :: Crypto crypto => Shelley.StakeReference crypto -> Aeson.Value + datum = + [ "datum" .= renderDatum mdatum + | isJust $ scriptDataSupportedInEra $ shelleyBasedToCardanoEra sbe + ] + sinceAlonzo = ["reference script" .= script] + in preAlonzo ++ datum ++ sinceAlonzo + where + renderDatum :: TxOutDatum CtxTx era -> Aeson.Value + renderDatum TxOutDatumNone = Aeson.Null + renderDatum (TxOutDatumHash _ h) = + Aeson.String $ serialiseToRawBytesHexText h + renderDatum (TxOutDatumInTx _ sData) = + scriptDataToJson ScriptDataJsonDetailedSchema sData + renderDatum (TxOutDatumInline _ _) = panic "TODO: Babbage" + + -- datum ShelleyBasedEraBabbage = panic "TODO: Babbage" + +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 @@ -269,7 +278,103 @@ friendlyPrices ExecutionUnitPrices{priceExecutionMemory, priceExecutionSteps} = 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 -> Aeson.Pair +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 -> Aeson.Pair +friendlyStakeCredential = \case + StakeCredentialByKey keyHash -> + "stake credential key hash" .= serialiseToRawBytesHexText keyHash + StakeCredentialByScript scriptHash -> + "stake credential script hash" .= serialiseToRawBytesHexText scriptHash + +friendlyPaymentCredential :: PaymentCredential -> Aeson.Pair +friendlyPaymentCredential = \case + PaymentCredentialByKey keyHash -> + "payment credential key hash" .= serialiseToRawBytesHexText keyHash + PaymentCredentialByScript scriptHash -> + "payment credential script hash" .= serialiseToRawBytesHexText scriptHash + +friendlyMirPot :: Shelley.MIRPot -> Aeson.Value +friendlyMirPot = \case + Shelley.ReservesMIR -> "reserves" + Shelley.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 = @@ -277,9 +382,9 @@ friendlyRational r = case d of 1 -> textShow n _ -> textShow n <> "/" <> textShow d - where - n = numerator r - d = denominator r + where + n = numerator r + d = denominator r friendlyFee :: TxFee era -> Aeson.Value friendlyFee = \case @@ -308,24 +413,24 @@ friendlyValue v = Aeson.fromText (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 a43526086dd..dbf91a7dc81 100644 --- a/cardano-cli/test/Test/Golden/TxView.hs +++ b/cardano-cli/test/Test/Golden/TxView.hs @@ -52,7 +52,18 @@ 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 updateProposalFile <- noteTempFile tempDir "update-proposal" @@ -98,7 +109,7 @@ golden_view_shelley = -- Create transaction body void $ - execCardanoCLI + execCardanoCLI $ [ "transaction", "build-raw" , "--shelley-era" , "--tx-in" @@ -114,6 +125,8 @@ golden_view_shelley = , "--update-proposal-file", updateProposalFile , "--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 908dc8e10bd..bf19c3f0eff 100644 --- a/cardano-cli/test/data/golden/allegra/transaction-view.out +++ b/cardano-cli/test/data/golden/allegra/transaction-view.out @@ -12,10 +12,10 @@ outputs: address era: Shelley amount: 99 Lovelace network: Testnet - payment credential: - key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 + payment credential key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 + reference script: null stake reference: - key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 + stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 required signers (payment key hashes needed for scripts): null update proposal: null validity range: diff --git a/cardano-cli/test/data/golden/mary/transaction-view.out b/cardano-cli/test/data/golden/mary/transaction-view.out index 8bf4ba7422d..dca95328dc3 100644 --- a/cardano-cli/test/data/golden/mary/transaction-view.out +++ b/cardano-cli/test/data/golden/mary/transaction-view.out @@ -29,10 +29,10 @@ outputs: asset f00d: 134 default asset: 130 network: Testnet - payment credential: - key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 + payment credential key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313 + reference script: null stake reference: - key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 + stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 required signers (payment key hashes needed for scripts): null update proposal: null validity range: diff --git a/cardano-cli/test/data/golden/shelley/transaction-view.out b/cardano-cli/test/data/golden/shelley/transaction-view.out index eee28b7be65..bd9b44a4447 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 collateral inputs: null era: Shelley fee: 32 Lovelace @@ -12,8 +41,8 @@ outputs: address era: Shelley amount: 31 Lovelace network: Testnet - payment credential: - key hash: bce78cb90f6da9ee778ef07ca881b489c38a188993e6870bd5a9ef77 + payment credential key hash: bce78cb90f6da9ee778ef07ca881b489c38a188993e6870bd5a9ef77 + reference script: null stake reference: null required signers (payment key hashes needed for scripts): null update proposal: @@ -43,6 +72,5 @@ validity range: withdrawals: - address: stake_test1up00fz9lyqs5sjks82k22eqz7a9srym9vysjgp3h2ua2v2cm522kg amount: 42 Lovelace - credential: - key hash: 5ef488bf2021484ad03aaca56402f74b0193656121240637573aa62b network: Testnet + stake credential key hash: 5ef488bf2021484ad03aaca56402f74b0193656121240637573aa62b