Improve 'renderTx' output for better debugging / analysis.

hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs

@@ -2,8 +2,10 @@ module Hydra.Cardano.Api.PlutusScript where
 
 import Hydra.Cardano.Api.Prelude
 
+import qualified Cardano.Ledger.Alonzo.Language as Ledger
 import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
 import Codec.Serialise (serialise)
+import Hydra.Cardano.Api.PlutusScriptVersion (HasPlutusScriptVersion (..))
 import qualified Plutus.V1.Ledger.Api as Plutus
 
 -- * Type Conversions
@@ -19,6 +21,18 @@ fromLedgerScript = \case
   Ledger.TimelockScript{} -> error "fromLedgerScript: TimelockScript"
   Ledger.PlutusScript _ bytes -> PlutusScriptSerialised bytes
 
+-- | Convert a cardano-api's 'PlutusScript' into a cardano-ledger's 'Script'.
+toLedgerScript ::
+  forall lang.
+  (HasPlutusScriptVersion lang) =>
+  PlutusScript lang ->
+  Ledger.Script (ShelleyLedgerEra AlonzoEra)
+toLedgerScript (PlutusScriptSerialised bytes) =
+  let lang = case plutusScriptVersion $ proxyToAsType (Proxy @lang) of
+        PlutusScriptV1 -> Ledger.PlutusV1
+        PlutusScriptV2 -> Ledger.PlutusV2
+   in Ledger.PlutusScript lang bytes
+
 -- | Convert a plutus' 'Script' into a cardano-api's 'PlutusScript'
 fromPlutusScript :: Plutus.Script -> PlutusScript lang
 fromPlutusScript =

hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs

@@ -10,16 +10,12 @@ import Hydra.Cardano.Api.KeyWitness (
 import Hydra.Cardano.Api.Lovelace (fromLedgerCoin)
 import Hydra.Cardano.Api.TxScriptValidity (toLedgerScriptValidity)
 
-import Cardano.Binary (serialize)
 import qualified Cardano.Ledger.Alonzo as Ledger
 import qualified Cardano.Ledger.Alonzo.PParams as Ledger
 import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
 import qualified Cardano.Ledger.Alonzo.Tx as Ledger
-import qualified Cardano.Ledger.Alonzo.TxBody as Ledger
 import qualified Cardano.Ledger.Alonzo.TxWitness as Ledger
 import qualified Cardano.Ledger.Era as Ledger
-import qualified Cardano.Ledger.Mary.Value as Ledger
-import qualified Data.ByteString.Lazy as BL
 import qualified Data.Map as Map
 import Data.Maybe.Strict (maybeToStrictMaybe, strictMaybeToMaybe)
 
@@ -54,70 +50,6 @@ totalExecutionCost pparams tx =
       _ ->
         mempty
 
--- | Obtain a human-readable pretty text representation of a transaction.
-renderTx :: Tx Era -> Text
-renderTx (Tx body _wits) =
-  unlines $
-    [show (getTxId body)]
-      <> inputLines
-      <> outputLines
-      <> mintLines
-      <> scriptLines
-      <> datumLines
-      <> redeemerLines
- where
-  ShelleyTxBody _era lbody scripts scriptsData _auxData _validity = body
-  outs = Ledger.outputs' lbody
-  TxBody TxBodyContent{txIns, txOuts, txMintValue} = body
-
-  inputLines =
-    "  Input set (" <> show (length txIns) <> ")" :
-    (("    - " <>) . renderTxIn . fst <$> txIns)
-
-  outputLines =
-    [ "  Outputs (" <> show (length txOuts) <> ")"
-    , "    total number of assets: " <> show totalNumberOfAssets
-    ]
-      <> (("    - " <>) . renderValue . txOutValue <$> txOuts)
-
-  txOutValue (TxOut _ value _) =
-    txOutValueToValue value
-
-  totalNumberOfAssets =
-    sum $
-      [ foldl' (\n inner -> n + Map.size inner) 0 outer
-      | Ledger.TxOut _ (Ledger.Value _ outer) _ <- toList outs
-      ]
-
-  mintLines =
-    [ "  Minted: " <> show txMintValue
-    ]
-
-  scriptLines =
-    [ "  Scripts (" <> show (length scripts) <> ")"
-    , "    total size (bytes):  " <> show totalScriptSize
-    ]
-      <> (("    - " <>) . prettyScript <$> scripts)
-
-  prettyScript = show . (Ledger.hashScript @(ShelleyLedgerEra Era))
-
-  totalScriptSize = sum $ BL.length . serialize <$> scripts
-
-  datumLines = case scriptsData of
-    TxBodyNoScriptData -> []
-    (TxBodyScriptData _ (Ledger.TxDats dats) _) ->
-      "  Datums (" <> show (length dats) <> ")" :
-      (("    - " <>) . showDatumAndHash <$> Map.toList dats)
-
-  showDatumAndHash (k, v) = show k <> " -> " <> show v
-
-  redeemerLines = case scriptsData of
-    TxBodyNoScriptData -> []
-    (TxBodyScriptData _ _ re) ->
-      let rdmrs = Map.elems $ Ledger.unRedeemers re
-       in "  Redeemers (" <> show (length rdmrs) <> ")" :
-          (("    - " <>) . show . fst <$> rdmrs)
-
 -- * Type Conversions
 
 -- | Convert a cardano-api's 'Tx' into a cardano-ledger's 'Tx' in the Alonzo era

hydra-node/src/Hydra/Ledger/Cardano.hs

@@ -14,14 +14,20 @@ import Hydra.Cardano.Api
 import Hydra.Ledger.Cardano.Builder
 
 import qualified Cardano.Api.UTxO as UTxO
-import Cardano.Binary (decodeAnnotator, serialize', unsafeDeserialize')
+import Cardano.Binary (decodeAnnotator, serialize, serialize', unsafeDeserialize')
 import qualified Cardano.Crypto.DSIGN as CC
 import Cardano.Crypto.Hash (SHA256, digest)
 import qualified Cardano.Ledger.Alonzo.PParams as Ledger.Alonzo
+import qualified Cardano.Ledger.Alonzo.Scripts as Ledger.Alonzo
 import qualified Cardano.Ledger.Alonzo.Tx as Ledger.Alonzo
+import qualified Cardano.Ledger.Alonzo.TxBody as Ledger
+import qualified Cardano.Ledger.Alonzo.TxWitness as Ledger
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Credential as Ledger
+import qualified Cardano.Ledger.Era as Ledger
+import qualified Cardano.Ledger.Mary.Value as Ledger
+import qualified Cardano.Ledger.SafeHash as Ledger
 import qualified Cardano.Ledger.Shelley.API.Mempool as Ledger
 import qualified Cardano.Ledger.Shelley.Genesis as Ledger
 import qualified Cardano.Ledger.Shelley.LedgerState as Ledger
@@ -33,13 +39,19 @@ import qualified Codec.CBOR.Encoding as CBOR
 import Control.Arrow (left)
 import Control.Monad (foldM)
 import qualified Control.State.Transition as Ledger
+import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BL
 import Data.Default (Default, def)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust)
 import Data.Maybe.Strict (StrictMaybe (..))
+import qualified Data.Text as T
 import Data.Text.Lazy.Builder (toLazyText)
 import Formatting.Buildable (build)
+import qualified Hydra.Contract.Commit as Commit
+import qualified Hydra.Contract.Head as Head
+import qualified Hydra.Contract.Initial as Initial
 import Hydra.Ledger (IsTx (..), Ledger (..), ValidationError (..))
 import Hydra.Ledger.Cardano.Json ()
 import Test.Cardano.Ledger.Alonzo.AlonzoEraGen ()
@@ -168,6 +180,157 @@ mkSimpleTx (txin, TxOut owner valueIn datum) (recipient, valueOut) sk = do
 
   fee = Lovelace 0
 
+-- | Obtain a human-readable pretty text representation of a transaction.
+renderTx :: Tx -> Text
+renderTx = renderTxWithUTxO mempty
+
+-- | Like 'renderTx', but uses the given UTxO to resolve inputs.
+renderTxWithUTxO :: UTxO -> Tx -> Text
+renderTxWithUTxO utxo (Tx body _wits) =
+  unlines $
+    [show (getTxId body)]
+      <> [""]
+      <> inputLines
+      <> [""]
+      <> outputLines
+      <> [""]
+      <> mintLines
+      <> [""]
+      <> scriptLines
+      <> [""]
+      <> datumLines
+      <> [""]
+      <> redeemerLines
+      <> [""]
+      <> requiredSignersLines
+ where
+  ShelleyTxBody lbody scripts scriptsData _auxData _validity = body
+  outs = Ledger.outputs' lbody
+  TxBody content = body
+
+  inputLines =
+    "== INPUTS (" <> show (length (txIns content)) <> ")" :
+    (("- " <>) . prettyTxIn <$> sortBy (compare `on` fst) (txIns content))
+
+  prettyTxIn (i, _) =
+    case UTxO.resolve i utxo of
+      Nothing -> renderTxIn i
+      Just o ->
+        case txOutAddress o of
+          AddressInEra _ addr ->
+            renderTxIn i
+              <> ("\n      " <> show addr)
+              <> ("\n      " <> prettyValue 1 (txOutValue o))
+              <> ("\n      " <> prettyDatumUtxo (txOutDatum o))
+
+  outputLines =
+    [ "== OUTPUTS (" <> show (length (txOuts content)) <> ")"
+    , "Total number of assets: " <> show totalNumberOfAssets
+    ]
+      <> (("- " <>) . prettyOut <$> txOuts content)
+
+  prettyOut o =
+    case txOutAddress o of
+      AddressInEra _ addr ->
+        mconcat
+          [ show addr
+          , "\n      " <> prettyValue 1 (txOutValue o)
+          , "\n      " <> prettyDatumCtx (txOutDatum o)
+          ]
+
+  totalNumberOfAssets =
+    sum $
+      [ foldl' (\n inner -> n + Map.size inner) 0 outer
+      | Ledger.TxOut _ (Ledger.Value _ outer) _ <- toList outs
+      ]
+
+  mintLines =
+    [ "== MINT/BURN\n" <> case txMintValue content of
+        TxMintValueNone -> "[]"
+        TxMintValue val _ -> prettyValue 0 val
+    ]
+
+  prettyValue n =
+    T.replace " + " indent . renderValue
+   where
+    indent = "\n  " <> T.replicate n "    "
+
+  prettyDatumUtxo :: TxOutDatum CtxUTxO -> Text
+  prettyDatumUtxo = \case
+    TxOutDatumNone ->
+      "TxOutDatumNone"
+    TxOutDatumHash h ->
+      "TxOutDatumHash " <> show h
+    _ ->
+      error "absurd"
+
+  prettyDatumCtx = \case
+    TxOutDatumNone ->
+      "TxOutDatumNone"
+    TxOutDatumHash h ->
+      "TxOutDatumHash " <> show h
+    TxOutDatum scriptData ->
+      "TxOutDatum " <> prettyScriptData scriptData
+
+  scriptLines =
+    [ "== SCRIPTS (" <> show (length scripts) <> ")"
+    , "Total size (bytes):  " <> show totalScriptSize
+    ]
+      <> (("- " <>) . prettyScript <$> scripts)
+
+  totalScriptSize = sum $ BL.length . serialize <$> scripts
+
+  prettyScript (fromLedgerScript -> script)
+    | script == fromPlutusScript @PlutusScriptV1 Initial.validatorScript =
+      "InitialScript Script (" <> scriptHash <> ")"
+    | script == fromPlutusScript @PlutusScriptV1 Commit.validatorScript =
+      "CommitScript Script (" <> scriptHash <> ")"
+    | script == fromPlutusScript @PlutusScriptV1 Head.validatorScript =
+      "Head Script (" <> scriptHash <> ")"
+    | otherwise =
+      "Unknown Script (" <> scriptHash <> ")"
+   where
+    scriptHash =
+      show (Ledger.hashScript @(ShelleyLedgerEra Era) (toLedgerScript script))
+
+  datumLines = case scriptsData of
+    TxBodyNoScriptData -> []
+    (TxBodyScriptData (Ledger.TxDats dats) _) ->
+      "== DATUMS (" <> show (length dats) <> ")" :
+      (("- " <>) . showDatumAndHash <$> Map.toList dats)
+
+  showDatumAndHash (k, v) =
+    mconcat
+      [ show (Ledger.extractHash k)
+      , "\n  "
+      , prettyScriptData (fromLedgerData v)
+      ]
+
+  prettyScriptData =
+    decodeUtf8 . Aeson.encode . scriptDataToJson ScriptDataJsonNoSchema
+
+  redeemerLines = case scriptsData of
+    TxBodyNoScriptData -> []
+    (TxBodyScriptData _ re) ->
+      let rdmrs = Map.toList $ Ledger.unRedeemers re
+       in "== REDEEMERS (" <> show (length rdmrs) <> ")" :
+          (("- " <>) . prettyRedeemer <$> rdmrs)
+
+  prettyRedeemer (Ledger.RdmrPtr tag ix, (redeemerData, redeemerBudget)) =
+    unwords
+      [ show tag <> "#" <> show ix
+      , mconcat
+          [ "( cpu = " <> show (Ledger.Alonzo.exUnitsSteps redeemerBudget)
+          , ", mem = " <> show (Ledger.Alonzo.exUnitsMem redeemerBudget) <> " )"
+          ]
+      , "\n  " <> prettyScriptData (fromLedgerData redeemerData)
+      ]
+
+  requiredSignersLines =
+    "== REQUIRED SIGNERS" : case txExtraKeyWits content of
+      TxExtraKeyWitnessesNone -> ["[]"]
+      TxExtraKeyWitnesses xs -> ("- " <>) . show <$> xs
+
 hashTxOuts :: [TxOut CtxUTxO] -> ByteString
 hashTxOuts =
   digest @SHA256 Proxy . serialize' . fmap toLedgerTxOut

hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs

@@ -146,7 +146,7 @@ import qualified Hydra.Chain.Direct.Fixture as Fixture
 import qualified Hydra.Contract.Head as Head
 import qualified Hydra.Contract.HeadState as Head
 import qualified Hydra.Data.Party as Party
-import Hydra.Ledger.Cardano (genKeyPair, genOutput)
+import Hydra.Ledger.Cardano (genKeyPair, genOutput, renderTxWithUTxO)
 import Hydra.Ledger.Cardano.Evaluate (evaluateTx)
 import Hydra.Party (Party, generateKey, vkey)
 import qualified Hydra.Party as Party
@@ -194,8 +194,7 @@ propTransactionDoesNotValidate (tx, lookupUTxO) =
           property True
         Right redeemerReport ->
           any isLeft (Map.elems redeemerReport)
-            & counterexample ("Tx: " <> toString (renderTx tx))
-            & counterexample ("Lookup utxo: " <> decodeUtf8 (encodePretty lookupUTxO))
+            & counterexample ("Tx: " <> toString (renderTxWithUTxO lookupUTxO tx))
             & counterexample ("Redeemer report: " <> show redeemerReport)
             & counterexample "Phase-2 validation should have failed"
 
@@ -206,13 +205,11 @@ propTransactionValidates (tx, lookupUTxO) =
    in case result of
         Left basicFailure ->
           property False
-            & counterexample ("Tx: " <> toString (renderTx tx))
-            & counterexample ("Lookup utxo: " <> decodeUtf8 (encodePretty lookupUTxO))
+            & counterexample ("Tx: " <> toString (renderTxWithUTxO lookupUTxO tx))
             & counterexample ("Phase-1 validation failed: " <> show basicFailure)
         Right redeemerReport ->
           all isRight (Map.elems redeemerReport)
-            & counterexample ("Tx: " <> toString (renderTx tx))
-            & counterexample ("Lookup utxo: " <> decodeUtf8 (encodePretty lookupUTxO))
+            & counterexample ("Tx: " <> toString (renderTxWithUTxO lookupUTxO tx))
             & counterexample ("Redeemer report: " <> show redeemerReport)
             & counterexample "Phase-2 validation failed"
 

hydra-node/test/Hydra/Chain/Direct/StateSpec.hs

@@ -38,6 +38,7 @@ import Hydra.Ledger.Cardano (
   genTxIn,
   genUTxO,
   genVerificationKey,
+  renderTx,
   simplifyUTxO,
  )
 import Hydra.Party (Party)

hydra-node/test/Hydra/Chain/Direct/TxSpec.hs

@@ -42,6 +42,7 @@ import Hydra.Ledger.Cardano (
   genOneUTxOFor,
   genUTxO,
   hashTxOuts,
+  renderTx,
   simplifyUTxO,
  )
 import Hydra.Party (Party, vkey)

hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs

@@ -35,7 +35,6 @@ import Hydra.Cardano.Api (
   VerificationKey,
   fromLedgerTx,
   mkVkAddress,
-  renderTx,
   toLedgerAddr,
   toLedgerTxIn,
  )
@@ -51,7 +50,7 @@ import Hydra.Chain.Direct.Wallet (
   watchUTxOUntil,
   withTinyWallet,
  )
-import Hydra.Ledger.Cardano (genKeyPair, genTxIn)
+import Hydra.Ledger.Cardano (genKeyPair, genTxIn, renderTx)
 import Hydra.Ledger.Cardano.Evaluate (epochInfo, systemStart)
 import Ouroboros.Consensus.Cardano.Block (HardForkBlock (..))
 import Ouroboros.Consensus.Shelley.Ledger (mkShelleyBlock)

hydra-node/test/Hydra/Ledger/CardanoSpec.hs

@@ -19,6 +19,7 @@ import Hydra.Ledger (applyTransactions)
 import Hydra.Ledger.Cardano (
   cardanoLedger,
   genSequenceOfValidTransactions,
+  renderTx,
  )
 import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
 import Test.Cardano.Ledger.MaryEraGen ()