Display redeemers in transaction view

cardano-cli/cardano-cli.cabal

@@ -147,6 +147,7 @@ library
                         Cardano.CLI.Run.Ping
                         Cardano.CLI.TopHandler
                         Cardano.CLI.Types.Common
+                        Cardano.CLI.Types.MonadWarning
                         Cardano.CLI.Types.Errors.AddressCmdError
                         Cardano.CLI.Types.Errors.AddressInfoError
                         Cardano.CLI.Types.Errors.BootstrapWitnessError
@@ -208,6 +209,7 @@ library
                       , cardano-slotting ^>= 0.1
                       , cardano-strict-containers ^>= 0.1
                       , cborg >= 0.2.4 && < 0.3
+                      , cborg-json
                       , containers
                       , contra-tracer
                       , cryptonite
@@ -298,6 +300,7 @@ test-suite cardano-cli-test
                       , tasty-hedgehog
                       , text
                       , time
+                      , transformers
 
   build-tool-depends:   tasty-discover:tasty-discover
 
@@ -308,6 +311,7 @@ test-suite cardano-cli-test
                         Test.Cli.Governance.Hash
                         Test.Cli.ITN
                         Test.Cli.JSON
+                        Test.Cli.MonadWarning
                         Test.Cli.Pioneers.Exercise1
                         Test.Cli.Pioneers.Exercise2
                         Test.Cli.Pioneers.Exercise3

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

@@ -1,12 +1,7 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DisambiguateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 
 -- | User-friendly pretty-printing for textual user interfaces (TUI)
@@ -25,6 +20,12 @@ import           Cardano.Api.Shelley (Address (ShelleyAddress), Hash (..),
                    ShelleyLedgerEra, StakeAddress (..), fromShelleyPaymentCredential,
                    fromShelleyStakeReference, toShelleyStakeCredential)
 
+import           Cardano.CLI.Types.MonadWarning (MonadWarning, eitherToWarning, runWarningIO)
+import           Cardano.Prelude (first)
+
+import           Codec.CBOR.Encoding (Encoding)
+import           Codec.CBOR.FlatTerm (fromFlatTerm, toFlatTerm)
+import           Codec.CBOR.JSON (decodeValue)
 import           Data.Aeson (Value (..), object, toJSON, (.=))
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
@@ -69,8 +70,8 @@ friendlyTx ::
   -> Tx era
   -> m (Either (FileError e) ())
 friendlyTx format mOutFile era =
-  cardanoEraConstraints era $
-    friendly format mOutFile . object . friendlyTxImpl era
+  cardanoEraConstraints era (\tx -> do pairs <- runWarningIO $ friendlyTxImpl era tx
+                                       friendly format mOutFile $ object pairs)
 
 friendlyTxBody ::
   (MonadIO m)
@@ -80,8 +81,8 @@ friendlyTxBody ::
   -> TxBody era
   -> m (Either (FileError e) ())
 friendlyTxBody format mOutFile era =
-  cardanoEraConstraints era $
-    friendly format mOutFile . object . friendlyTxBodyImpl era
+  cardanoEraConstraints era (\tx -> do pairs <- runWarningIO $ friendlyTxBodyImpl era tx
+                                       friendly format mOutFile $ object pairs)
 
 friendlyProposal ::
   (MonadIO m)
@@ -112,12 +113,12 @@ friendlyProposalImpl
     , "anchor" .= pProcAnchor
     ]
 
-friendlyTxImpl :: ()
+friendlyTxImpl :: MonadWarning m
   => CardanoEra era
   -> Tx era
-  -> [Aeson.Pair]
+  -> m [Aeson.Pair]
 friendlyTxImpl era (Tx body witnesses) =
-  ("witnesses" .= map friendlyKeyWitness witnesses) : friendlyTxBodyImpl era body
+  (("witnesses" .= map friendlyKeyWitness witnesses) :) <$> friendlyTxBodyImpl era body
 
 friendlyKeyWitness :: KeyWitness era -> Aeson.Value
 friendlyKeyWitness =
@@ -129,13 +130,13 @@ friendlyKeyWitness =
       ShelleyKeyWitness _era (L.WitVKey key signature) ->
         ["key" .= textShow key, "signature" .= textShow signature]
 
-friendlyTxBodyImpl :: ()
+friendlyTxBodyImpl :: MonadWarning m
   => CardanoEra era
   -> TxBody era
-  -> [Aeson.Pair]
+  -> m [Aeson.Pair]
 friendlyTxBodyImpl
   era
-  (TxBody
+  tb@(TxBody
     TxBodyContent
       { txAuxScripts
       , txCertificates
@@ -151,28 +152,43 @@ friendlyTxBodyImpl
       , txInsReference
       , txUpdateProposal
       , txValidityLowerBound
-       ,txValidityUpperBound
+      , txValidityUpperBound
       , txWithdrawals
       }) =
-  cardanoEraConstraints era
-    [ "auxiliary scripts" .= friendlyAuxScripts txAuxScripts
-    , "certificates" .= forEraInEon era Null (`friendlyCertificates` txCertificates)
-    , "collateral inputs" .= friendlyCollateralInputs txInsCollateral
-    , "era" .= era
-    , "fee" .= friendlyFee txFee
-    , "inputs" .= friendlyInputs txIns
-    , "metadata" .= friendlyMetadata txMetadata
-    , "mint" .= friendlyMintValue txMintValue
-    , "outputs" .= map (friendlyTxOut era) txOuts
-    , "reference inputs" .= friendlyReferenceInputs txInsReference
-    , "total collateral" .= friendlyTotalCollateral txTotalCollateral
-    , "return collateral" .= friendlyReturnCollateral era txReturnCollateral
-    , "required signers (payment key hashes needed for scripts)" .=
-        friendlyExtraKeyWits txExtraKeyWits
-    , "update proposal" .= friendlyUpdateProposal txUpdateProposal
-    , "validity range" .= friendlyValidityRange era (txValidityLowerBound, txValidityUpperBound)
-    , "withdrawals" .= friendlyWithdrawals txWithdrawals
-    ]
+  do redeemerDetails <- redeemerIfShelleyBased era tb
+     return $ cardanoEraConstraints era
+                ( redeemerDetails ++
+                  [ "auxiliary scripts" .= friendlyAuxScripts txAuxScripts
+                  , "certificates" .= forEraInEon era Null (`friendlyCertificates` txCertificates)
+                  , "collateral inputs" .= friendlyCollateralInputs txInsCollateral
+                  , "era" .= era
+                  , "fee" .= friendlyFee txFee
+                  , "inputs" .= friendlyInputs txIns
+                  , "metadata" .= friendlyMetadata txMetadata
+                  , "mint" .= friendlyMintValue txMintValue
+                  , "outputs" .= map (friendlyTxOut era) txOuts
+                  , "reference inputs" .= friendlyReferenceInputs txInsReference
+                  , "total collateral" .= friendlyTotalCollateral txTotalCollateral
+                  , "return collateral" .= friendlyReturnCollateral era txReturnCollateral
+                  , "required signers (payment key hashes needed for scripts)" .=
+                      friendlyExtraKeyWits txExtraKeyWits
+                  , "update proposal" .= friendlyUpdateProposal txUpdateProposal
+                  , "validity range" .= friendlyValidityRange era (txValidityLowerBound, txValidityUpperBound)
+                  , "withdrawals" .= friendlyWithdrawals txWithdrawals
+                  ])
+
+redeemerIfShelleyBased :: MonadWarning m => CardanoEra era -> TxBody era -> m [Aeson.Pair]
+redeemerIfShelleyBased era tb =
+  caseByronOrShelleyBasedEra (return [])
+                             (\shEra -> do redeemerInfo <- friendlyRedeemer shEra tb
+                                           return [ "redeemers" .=  redeemerInfo ]) era
+
+friendlyRedeemer :: MonadWarning m => ShelleyBasedEra era -> TxBody era -> m Aeson.Value
+friendlyRedeemer _ (ShelleyTxBody _ _ _ TxBodyNoScriptData _ _) = return Aeson.Null
+friendlyRedeemer _ (ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = encodingToJSON $ L.toCBOR r
+  where encodingToJSON :: MonadWarning m => Encoding -> m Aeson.Value
+        encodingToJSON e = eitherToWarning Aeson.Null $ first ("Error decoding redeemer: " ++) $
+                               fromFlatTerm (decodeValue True) $ toFlatTerm e
 
 friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value
 friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null
@@ -628,4 +644,3 @@ friendlyCollateralInputs :: TxInsCollateral era -> Aeson.Value
 friendlyCollateralInputs = \case
   TxInsCollateralNone -> Null
   TxInsCollateral _ txins -> toJSON txins
-

cardano-cli/src/Cardano/CLI/Types/MonadWarning.hs

@@ -0,0 +1,82 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Cardano.CLI.Types.MonadWarning
+--
+-- This module defines the 'MonadWarning' type class, which provides a common
+-- interface for monads that support reporting warning messages without
+-- aborting the computation (unlike with exceptions, Either, or MonadFail,
+-- which either fail or return a value).
+--
+-- It also includes two functions that instantiate it into either a 'MonadIO'
+-- ('runWarningIO') or a 'StateT' monad with a '[String]' as state
+-- ('runWarningStateT') respectively.
+--
+-- In the case of 'MonadIO', warnings are printed to 'stderr'.
+-- In the case of 'StateT', with a '[String]' state, warnings are added to the
+-- list in the state.
+--
+-- By using the 'MonadWarning' type class, users can write code that remains
+-- agnostic to the specific monad in which it operates, and to easily change
+-- it at a later stage if necessary.
+--
+-- Example usage:
+--
+-- @
+-- computeWithWarning :: (MonadWarning m) => Int -> m Int
+-- computeWithWarning x = do
+--   when (x < 0) $ reportIssue "Input value is negative!"
+--   return (x * 2)
+--
+-- -- Using 'IO' monad to perform computation and report warnings.
+-- main :: IO ()
+-- main = do
+--   result <- runWarningIO $ computeWithWarning (-4)
+--   putStrLn $ "Result: " ++ show result
+-- @
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
+
+module Cardano.CLI.Types.MonadWarning
+  ( MonadWarning(..)
+  , eitherToWarning
+  , runWarningIO
+  , runWarningStateT
+  ) where
+
+import           Control.Monad.IO.Class (MonadIO, liftIO)
+import           Control.Monad.State (MonadState (..))
+import           Control.Monad.Trans.State (StateT)
+import           System.IO (hPutStrLn, stderr)
+
+-- | Type class for monads that support reporting warnings.
+class Monad m => MonadWarning m where
+  -- | Report a warning issue.
+  reportIssue :: String -- ^ The warning message to report.
+              -> m ()   -- ^ The action that reports the warning.
+
+-- | Wrapper newtype for 'MonadIO' with 'MonadWarning' instance.
+-- We need to have wrapper to avoid overlapping instances.
+newtype WarningIO m a = WarningIO { runWarningIO :: m a }
+  deriving (Functor, Applicative, Monad, MonadIO)
+
+-- | This instance prints the issue to the 'stderr'.
+instance MonadIO m => MonadWarning (WarningIO m) where
+  reportIssue :: String -> WarningIO m ()
+  reportIssue issue = liftIO (hPutStrLn stderr issue)
+
+-- | Wrapper newtype for 'StateT [String]' with 'MonadWarning' instance.
+newtype WarningStateT m a = WarningStateT { runWarningStateT :: StateT [String] m a }
+  deriving (Functor, Applicative, Monad, MonadState [String])
+
+-- | This instance adds the issue to the '[String]' in the state.
+instance Monad m => MonadWarning (WarningStateT m) where
+  reportIssue :: String -> WarningStateT m ()
+  reportIssue issue = state (\ x -> ((), issue : x))
+
+-- | Convert an 'Either' into a 'MonadWarning'. If 'Either' is 'Left'
+-- it returns the default value (first parameter) and reports the value
+-- as an error. -- If 'Either' is 'Right' it just returns the value.
+eitherToWarning :: MonadWarning m => a -> Either String a -> m a
+eitherToWarning def = either (\issue -> do {reportIssue issue; return def}) return

cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs

@@ -4,6 +4,7 @@ module Test.Golden.TxView
   ( hprop_golden_view_shelley_yaml
   , hprop_golden_view_allegra_yaml
   , hprop_golden_view_mary_yaml
+  , hprop_golden_view_redeemer
   , hprop_golden_view_alonzo_yaml
   , hprop_golden_view_alonzo_signed_yaml
   ) where
@@ -248,6 +249,38 @@ hprop_golden_view_mary_yaml =
         ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"]
     H.diffVsGoldenFile result "test/cardano-cli-golden/files/golden/mary/transaction-view.out"
 
+hprop_golden_view_redeemer :: Property
+hprop_golden_view_redeemer = do
+  propertyOnce $
+    moduleWorkspace "tmp" $ \tempDir -> do
+      transactionBodyFile <- noteTempFile tempDir "transaction-body-file"
+      scriptTxBody transactionBodyFile
+
+      -- View transaction body
+      result <-
+        execCardanoCLI
+          ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"]
+
+      H.diffVsGoldenFile result "test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out"
+  where
+  scriptTxBody :: FilePath -> Integration ()
+  scriptTxBody transactionBodyFile =
+      void $ execCardanoCLI
+        [ "babbage", "transaction", "build-raw"
+        , "--tx-in"
+        ,   "ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213"
+        , "--tx-in-datum-value", "6666"
+        , "--tx-in-redeemer-value", "42"
+        , "--tx-in-script-file", "test/cardano-cli-golden/files/input/AlwaysSucceeds.plutus"
+        , "--tx-in-execution-units", "(100, 200)"
+        , "--tx-in-collateral"
+        ,   "c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256"
+        , "--protocol-params-file"
+        ,   "test/cardano-cli-golden/files/input/babbage/transaction-calculate-min-fee/protocol-params.json"
+        , "--fee", "213"
+        , "--out-file", transactionBodyFile
+        ]
+
 createAlonzoTxBody :: Maybe FilePath -> FilePath -> Integration ()
 createAlonzoTxBody mUpdateProposalFile transactionBodyFile = do
   void $

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

@@ -17,6 +17,7 @@ outputs:
   reference script: null
   stake reference:
     stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0
+redeemers: null
 reference inputs: null
 required signers (payment key hashes needed for scripts): null
 return collateral: null

cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out

@@ -9,6 +9,7 @@ inputs:
 metadata: null
 mint: null
 outputs: []
+redeemers: []
 reference inputs: null
 required signers (payment key hashes needed for scripts):
 - 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27

cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out

@@ -9,6 +9,7 @@ inputs:
 metadata: null
 mint: null
 outputs: []
+redeemers: []
 reference inputs: null
 required signers (payment key hashes needed for scripts):
 - 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27

cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out

@@ -0,0 +1,26 @@
+auxiliary scripts: null
+certificates: null
+collateral inputs:
+- c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256
+era: Babbage
+fee: 213 Lovelace
+inputs:
+- ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213
+metadata: null
+mint: null
+outputs: []
+redeemers:
+- - 0
+  - 0
+  - 42
+  - - 200
+    - 100
+reference inputs: []
+required signers (payment key hashes needed for scripts): null
+return collateral: null
+total collateral: null
+update proposal: null
+validity range:
+  lower bound: null
+  upper bound: null
+withdrawals: null

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

@@ -33,6 +33,7 @@ outputs:
   reference script: null
   stake reference:
     stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0
+redeemers: null
 reference inputs: null
 required signers (payment key hashes needed for scripts): null
 return collateral: null

cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out

@@ -46,6 +46,7 @@ outputs:
   payment credential key hash: bce78cb90f6da9ee778ef07ca881b489c38a188993e6870bd5a9ef77
   reference script: null
   stake reference: null
+redeemers: null
 reference inputs: null
 required signers (payment key hashes needed for scripts): null
 return collateral: null

cardano-cli/test/cardano-cli-golden/files/input/AlwaysSucceeds.plutus

@@ -0,0 +1,5 @@
+{
+    "type": "PlutusScriptV1",
+    "description": "",
+    "cborHex": "4e4d01000033222220051200120011"
+}