cardano-cli transaction view: Add friendly certificate printing

cardano-api/src/Cardano/Api/Address.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -70,18 +71,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           Cardano.Api.Eras
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Hash
@@ -466,6 +466,15 @@ data StakeCredential
        | StakeCredentialByScript  ScriptHash
   deriving (Eq, Ord, Show)
 
+instance ToJSON StakeCredential where
+  toJSON =
+    Aeson.object .
+    \case
+      StakeCredentialByKey keyHash ->
+        ["key hash" .= serialiseToRawBytesHexText keyHash]
+      StakeCredentialByScript scriptHash ->
+        ["script hash" .= serialiseToRawBytesHexText scriptHash]
+
 data StakeAddressReference
        = StakeAddressByValue   StakeCredential
        | StakeAddressByPointer StakeAddressPointer
@@ -606,4 +615,3 @@ fromShelleyStakeReference (Shelley.StakeRefPtr ptr) =
   StakeAddressByPointer (StakeAddressPointer ptr)
 fromShelleyStakeReference Shelley.StakeRefNull =
   NoStakeAddress
-

cardano-cli/src/Cardano/CLI/Run/Friendly.hs

@@ -21,13 +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.Byron (Lovelace (..))
-import           Cardano.Api.Shelley (Address (ShelleyAddress), StakeAddress (..))
-import qualified Shelley.Spec.Ledger.API as Shelley
+import           Cardano.Api.Shelley (Address (ShelleyAddress), StakeAddress (..),
+                   StakeCredential (..), StakePoolParameters (..), fromShelleyPaymentCredential,
+                   fromShelleyStakeCredential, fromShelleyStakeReference)
 
 import           Cardano.CLI.Helpers (textShow)
 
@@ -101,31 +100,35 @@ 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) =
+  object $
   case addr of
     AddressInEra ByronAddressInAnyEra byronAdr ->
-      object  [ "address era" .= String "Byron"
-              , "address" .= serialiseAddress byronAdr
-              , "amount" .= friendlyTxOutValue amount
-              ]
-
+      [ "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) :
+            friendlyStakeReference (fromShelleyStakeReference stake) :
             [ "address era" .= Aeson.String "Shelley"
             , "network" .= net
-            , "payment credential" .= cred
-            , "stake reference" .= friendlyStakeReference stake
             , "address" .= serialiseAddress saddr
             , "amount" .= friendlyTxOutValue amount
             ]
@@ -134,21 +137,20 @@ friendlyTxOut (TxOut addr amount mdatum) =
           datum ShelleyBasedEraAllegra = []
           datum ShelleyBasedEraMary = []
           datum ShelleyBasedEraAlonzo = ["datum" .= renderDatum mdatum]
-      in object $ preAlonzo ++ datum sbe
+      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
+    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 -> (Text, Aeson.Value)
 friendlyStakeReference = \case
-  Shelley.StakeRefBase cred -> toJSON cred
-  Shelley.StakeRefNull -> Null
-  Shelley.StakeRefPtr ptr -> toJSON ptr
+  NoStakeAddress -> "stake reference" .= Null
+  StakeAddressByPointer ptr -> "stake reference" .= String (show ptr)
+  StakeAddressByValue cred -> friendlyStakeCredential "reference" cred
 
 friendlyUpdateProposal :: TxUpdateProposal era -> Aeson.Value
 friendlyUpdateProposal = \case
@@ -157,8 +159,110 @@ friendlyUpdateProposal = \case
 
 friendlyCertificates :: TxCertificates ViewTx era -> Aeson.Value
 friendlyCertificates = \case
-  TxCertificatesNone -> Null
-  TxCertificates _ cs _ -> toJSON $ map textShow cs
+  TxCertificatesNone    -> Null
+  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 :: Text -> StakeCredential -> (Text, Aeson.Value)
+friendlyStakeCredential subkey = \case
+  StakeCredentialByKey keyHash ->
+    unwords
+      ("stake" : [subkey | subkey /= ""] ++ ["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

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 <-

cardano-cli/test/data/golden/allegra/transaction-view.out

@@ -11,10 +11,8 @@ outputs:
   address era: Shelley
   amount: 99 Lovelace
   network: Testnet
-  payment credential:
-    key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313
-  stake reference:
-    key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0
+  payment credential key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313
+  stake reference credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0
 update proposal: null
 validity range:
   lower bound: null

cardano-cli/test/data/golden/mary/transaction-view.out

@@ -28,10 +28,8 @@ outputs:
       asset f00d: 134
       default asset: 130
   network: Testnet
-  payment credential:
-    key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313
-  stake reference:
-    key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0
+  payment credential key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313
+  stake reference credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0
 update proposal: null
 validity range:
   lower bound: 140

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,15 +40,13 @@ 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:
   time to live: 33
 withdrawals:
 - address: stake_test1up00fz9lyqs5sjks82k22eqz7a9srym9vysjgp3h2ua2v2cm522kg
   amount: 42 Lovelace
-  credential:
-    key hash: 5ef488bf2021484ad03aaca56402f74b0193656121240637573aa62b
   network: Testnet
+  stake credential key hash: 5ef488bf2021484ad03aaca56402f74b0193656121240637573aa62b