Merge #3377

3377: cardano-cli transaction view: Add friendly certificate printing r=cblp a=cblp

Fix #2386

Co-authored-by: Yuriy Syrovetskiy <yuriy.syrovetskiy@iohk.io>

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

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

@@ -22,11 +22,14 @@ import           Data.Yaml (array)
 import           Data.Yaml.Pretty (setConfCompare)
 import qualified Data.Yaml.Pretty as Yaml
 
+import           Cardano.Ledger.Shelley.TxBody (MIRPot (ReservesMIR, TreasuryMIR))
+
 import           Cardano.Api as Api
 import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness))
 import           Cardano.Api.Shelley (Address (ShelleyAddress),
-                   KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..))
-import           Cardano.Ledger.Crypto (Crypto)
+                   KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..),
+                   StakeCredential (..), StakePoolParameters (..), fromShelleyPaymentCredential,
+                   fromShelleyStakeCredential, fromShelleyStakeReference)
 import qualified Cardano.Ledger.Shelley.API as Shelley
 
 import           Cardano.CLI.Helpers (textShow)
@@ -123,62 +126,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)
               ]
-
-    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
+            datum :: [Aeson.Pair]
+            datum =
+              [ "datum" .= renderDatum mdatum
+              | isJust $ scriptDataSupportedInEra $ shelleyBasedToCardanoEra sbe
+              ]
+        in preAlonzo ++ datum
+ 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 :: 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,17 +276,113 @@ 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 -> (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
+ where
+  n = numerator r
+  d = denominator r
 
 friendlyFee :: TxFee era -> Aeson.Value
 friendlyFee = \case
@@ -308,24 +411,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

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

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

@@ -12,10 +12,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
 required signers (payment key hashes needed for scripts): null
 update proposal: null
 validity range:

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

@@ -29,10 +29,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
 required signers (payment key hashes needed for scripts): null
 update proposal: null
 validity range: