From b5b997eca931042018204beb18e60c352ae4f483 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 25 Mar 2022 10:11:15 +0100 Subject: [PATCH] Improve 'renderTx' output for better debugging / analysis. --- .../src/Hydra/Cardano/Api/PlutusScript.hs | 14 ++ hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs | 68 -------- hydra-node/src/Hydra/Ledger/Cardano.hs | 165 +++++++++++++++++- .../Hydra/Chain/Direct/Contract/Mutation.hs | 11 +- .../test/Hydra/Chain/Direct/StateSpec.hs | 1 + hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 1 + .../test/Hydra/Chain/Direct/WalletSpec.hs | 3 +- hydra-node/test/Hydra/Ledger/CardanoSpec.hs | 1 + 8 files changed, 186 insertions(+), 78 deletions(-) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs index bea4d425609..f554fd7d76e 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs +++ b/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 = diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs index 9ca5f0db239..1ddd655eb2b 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs +++ b/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 diff --git a/hydra-node/src/Hydra/Ledger/Cardano.hs b/hydra-node/src/Hydra/Ledger/Cardano.hs index 6a26146a9cd..553e98b682a 100644 --- a/hydra-node/src/Hydra/Ledger/Cardano.hs +++ b/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 diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs index 12a9b6b5354..348f7fc5291 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs +++ b/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" diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs index fb2b518a93a..5ac3580de41 100644 --- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs +++ b/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) diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index 87d4da36080..8bb78ae04ed 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/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) diff --git a/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs b/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs index bfa8b94f609..2dae8c9a4b6 100644 --- a/hydra-node/test/Hydra/Chain/Direct/WalletSpec.hs +++ b/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) diff --git a/hydra-node/test/Hydra/Ledger/CardanoSpec.hs b/hydra-node/test/Hydra/Ledger/CardanoSpec.hs index e54e454d9a2..d4b7c169bff 100644 --- a/hydra-node/test/Hydra/Ledger/CardanoSpec.hs +++ b/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 ()