-- | Pretty printing transactions and utxo's
module Hydra.Cardano.Api.Pretty where

import Hydra.Cardano.Api qualified as Api
import Hydra.Cardano.Api.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Binary (serialize)
import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
import Cardano.Ledger.Core qualified as Ledger
import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as BL
import Data.Function (on)
import Data.List (intercalate, sort, sortBy)
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import GHC.IsList (IsList (..))
import Hydra.Cardano.Api.ScriptData (fromLedgerData)

-- | Obtain a human-readable pretty text representation of a transaction.
renderTx :: Api.Tx -> String
renderTx :: Tx -> String
renderTx = UTxO -> Tx -> String
renderTxWithUTxO UTxO
forall a. Monoid a => a
mempty

-- | Like 'renderTx', but uses the given UTxO to resolve inputs.
renderTxWithUTxO :: UTxO -> Api.Tx -> String
renderTxWithUTxO :: UTxO -> Tx -> String
renderTxWithUTxO UTxO
utxo (Tx TxBody Era
body [KeyWitness Era]
_wits) =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate
      [String
""]
      [ String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ TxId -> String
forall a. Show a => a -> String
show (TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId TxBody Era
body)
      , [String]
inputLines
      , [String]
collateralInputLines
      , [String]
referenceInputLines
      , [String]
outputLines
      , [String]
totalCollateralLines
      , [String]
returnCollateralLines
      , [String]
feeLines
      , [String]
validityLines
      , [String]
mintLines
      , [String]
scriptLines
      , [String]
datumLines
      , [String]
redeemerLines
      , [String]
requiredSignersLines
      , [String]
metadataLines
      ]
 where
  Api.ShelleyTxBody TxBody LedgerEra
_lbody [Script LedgerEra]
scripts TxBodyScriptData
scriptsData Maybe (AlonzoTxAuxData LedgerEra)
_auxData TxScriptValidity
_validity = TxBody Era
body
  outs :: [TxOut CtxTx Era]
outs = TxBodyContent ViewTx Era -> [TxOut CtxTx Era]
forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts TxBodyContent ViewTx Era
content
  content :: TxBodyContent ViewTx Era
content = TxBody Era -> TxBodyContent ViewTx Era
forall era. TxBody era -> TxBodyContent ViewTx era
getTxBodyContent TxBody Era
body

  inputLines :: [String]
inputLines =
    String
"== INPUTS (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBodyContent ViewTx Era
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))]
forall build era. TxBodyContent build era -> TxIns build era
txIns TxBodyContent ViewTx Era
content)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String
"- " <>) (String -> String)
-> ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> String)
-> (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> String
prettyTxIn (TxIn -> String)
-> ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> TxIn)
-> (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> String)
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))]
-> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))
 -> (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> Ordering)
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))]
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (TxIn -> TxIn -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TxIn -> TxIn -> Ordering)
-> ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> TxIn)
-> (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))
-> (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> TxIn
forall a b. (a, b) -> a
fst) (TxBodyContent ViewTx Era
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era))]
forall build era. TxBodyContent build era -> TxIns build era
txIns TxBodyContent ViewTx Era
content))

  referenceInputLines :: [String]
referenceInputLines =
    String
"== REFERENCE INPUTS (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
referenceInputs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String
"- " <>) (String -> String) -> (TxIn -> String) -> TxIn -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> String
prettyTxIn (TxIn -> String) -> [TxIn] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
sort [TxIn]
referenceInputs)

  referenceInputs :: [TxIn]
referenceInputs =
    case TxBodyContent ViewTx Era -> TxInsReference Era
forall build era. TxBodyContent build era -> TxInsReference era
txInsReference TxBodyContent ViewTx Era
content of
      TxInsReference Era
Api.TxInsReferenceNone -> []
      Api.TxInsReference [TxIn]
refInputs -> [TxIn]
refInputs

  collateralInputLines :: [String]
collateralInputLines =
    String
"== COLLATERAL INPUTS (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
collateralInputs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String
"- " <>) (String -> String) -> (TxIn -> String) -> TxIn -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> String
prettyTxIn (TxIn -> String) -> [TxIn] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
sort [TxIn]
collateralInputs)

  collateralInputs :: [TxIn]
collateralInputs =
    case TxBodyContent ViewTx Era -> TxInsCollateral Era
forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral TxBodyContent ViewTx Era
content of
      TxInsCollateral Era
Api.TxInsCollateralNone -> []
      Api.TxInsCollateral [TxIn]
refInputs -> [TxIn]
refInputs

  prettyTxIn :: TxIn -> String
prettyTxIn TxIn
i =
    case TxIn -> UTxO -> Maybe (TxOut CtxUTxO Era)
forall out. TxIn -> UTxO' out -> Maybe out
UTxO.resolve TxIn
i UTxO
utxo of
      Maybe (TxOut CtxUTxO Era)
Nothing -> Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ TxIn -> Text
renderTxIn TxIn
i
      Just TxOut CtxUTxO Era
o ->
        Text -> String
T.unpack (TxIn -> Text
renderTxIn TxIn
i)
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
"\n      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> AddressInEra -> String
prettyAddr (TxOut CtxUTxO Era -> AddressInEra
forall ctx. TxOut ctx -> AddressInEra
Api.txOutAddress TxOut CtxUTxO Era
o))
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
"\n      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> String
prettyValue Int
1 (TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
Api.txOutValue TxOut CtxUTxO Era
o))
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
"\n      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TxOutDatum CtxUTxO Era -> String
forall {ctx}. TxOutDatum ctx Era -> String
prettyDatumUtxo (TxOut CtxUTxO Era -> TxOutDatum CtxUTxO Era
forall ctx. TxOut ctx -> TxOutDatum ctx
Api.txOutDatum TxOut CtxUTxO Era
o))
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
"\n      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ReferenceScript Era -> String
prettyReferenceScript (TxOut CtxUTxO Era -> ReferenceScript Era
forall ctx. TxOut ctx -> ReferenceScript Era
Api.txOutReferenceScript TxOut CtxUTxO Era
o))

  outputLines :: [String]
  outputLines :: [String]
outputLines =
    [ String
"== OUTPUTS (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([TxOut CtxTx Era] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut CtxTx Era]
outs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
    , String
"Total number of assets: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
totalNumberOfAssets
    ]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ((String
"- " <>) (String -> String)
-> (TxOut CtxTx Era -> String) -> TxOut CtxTx Era -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx Era -> String
prettyOut (TxOut CtxTx Era -> String) -> [TxOut CtxTx Era] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut CtxTx Era]
outs)

  prettyOut :: TxOut CtxTx Era -> String
prettyOut TxOut CtxTx Era
o =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ AddressInEra -> String
prettyAddr (TxOut CtxTx Era -> AddressInEra
forall ctx. TxOut ctx -> AddressInEra
Api.txOutAddress TxOut CtxTx Era
o)
      , String
"\n      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> String
prettyValue Int
1 (TxOut CtxTx Era -> Value
forall ctx. TxOut ctx -> Value
Api.txOutValue TxOut CtxTx Era
o)
      , String
"\n      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TxOutDatum CtxTx -> String
prettyDatumCtx (TxOut CtxTx Era -> TxOutDatum CtxTx
forall ctx. TxOut ctx -> TxOutDatum ctx
Api.txOutDatum TxOut CtxTx Era
o)
      ]

  prettyAddr :: AddressInEra -> String
prettyAddr = \case
    Api.ShelleyAddressInEra Address ShelleyAddr
addr -> Address ShelleyAddr -> String
forall a. Show a => a -> String
show Address ShelleyAddr
addr
    Api.ByronAddressInEra Address ByronAddr
addr -> Address ByronAddr -> String
forall a. Show a => a -> String
show Address ByronAddr
addr

  totalNumberOfAssets :: Int
totalNumberOfAssets =
    let totalValue :: Value
totalValue = (TxOut CtxTx Era -> Value) -> [TxOut CtxTx Era] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut CtxTx Era -> Value
forall ctx. TxOut ctx -> Value
Api.txOutValue [TxOut CtxTx Era]
outs
     in [(AssetId, Quantity)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(AssetId, Quantity)] -> Int) -> [(AssetId, Quantity)] -> Int
forall a b. (a -> b) -> a -> b
$ Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList Value
totalValue

  totalCollateralLines :: [String]
  totalCollateralLines :: [String]
totalCollateralLines =
    [ String
"== TOTAL COLLATERAL"
    , TxTotalCollateral Era -> String
forall a. Show a => a -> String
show (TxTotalCollateral Era -> String)
-> TxTotalCollateral Era -> String
forall a b. (a -> b) -> a -> b
$ TxBodyContent ViewTx Era -> TxTotalCollateral Era
forall build era. TxBodyContent build era -> TxTotalCollateral era
txTotalCollateral TxBodyContent ViewTx Era
content
    ]

  returnCollateralLines :: [String]
  returnCollateralLines :: [String]
returnCollateralLines =
    [ String
"== RETURN COLLATERAL"
    , TxReturnCollateral CtxTx Era -> String
forall a. Show a => a -> String
show (TxReturnCollateral CtxTx Era -> String)
-> TxReturnCollateral CtxTx Era -> String
forall a b. (a -> b) -> a -> b
$ TxBodyContent ViewTx Era -> TxReturnCollateral CtxTx Era
forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txReturnCollateral TxBodyContent ViewTx Era
content
    ]

  feeLines :: [String]
  feeLines :: [String]
feeLines =
    [ String
"== FEE"
    , TxFee Era -> String
forall a. Show a => a -> String
show (TxFee Era -> String) -> TxFee Era -> String
forall a b. (a -> b) -> a -> b
$ TxBodyContent ViewTx Era -> TxFee Era
forall build era. TxBodyContent build era -> TxFee era
txFee TxBodyContent ViewTx Era
content
    ]

  validityLines :: [String]
  validityLines :: [String]
validityLines =
    [ String
"== VALIDITY"
    , TxValidityLowerBound Era -> String
forall a. Show a => a -> String
show (TxBodyContent ViewTx Era -> TxValidityLowerBound Era
forall build era.
TxBodyContent build era -> TxValidityLowerBound era
txValidityLowerBound TxBodyContent ViewTx Era
content)
    , TxValidityUpperBound Era -> String
forall a. Show a => a -> String
show (TxBodyContent ViewTx Era -> TxValidityUpperBound Era
forall build era.
TxBodyContent build era -> TxValidityUpperBound era
txValidityUpperBound TxBodyContent ViewTx Era
content)
    ]

  mintLines :: [String]
mintLines =
    [ String
"== MINT/BURN\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> String
prettyValue Int
0 (TxMintValue ViewTx Era -> Value
forall build era. TxMintValue build era -> Value
txMintValueToValue (TxMintValue ViewTx Era -> Value)
-> TxMintValue ViewTx Era -> Value
forall a b. (a -> b) -> a -> b
$ TxBodyContent ViewTx Era -> TxMintValue ViewTx Era
forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue TxBodyContent ViewTx Era
content)
    ]

  prettyValue :: Int -> Value -> String
prettyValue Int
n =
    Text -> String
T.unpack (Text -> String) -> (Value -> Text) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" + " Text
indent (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
renderValue
   where
    indent :: Text
indent = Text
"\n  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
n Text
"    "

  prettyDatumUtxo :: TxOutDatum ctx Era -> String
prettyDatumUtxo = \case
    TxOutDatum ctx Era
TxOutDatumNone ->
      String
"TxOutDatumNone"
    Api.TxOutDatumHash Hash ScriptData
h ->
      String
"TxOutDatumHash " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Hash ScriptData -> String
forall a. Show a => a -> String
show Hash ScriptData
h
    Api.TxOutDatumInline HashableScriptData
scriptData ->
      String
"TxOutDatumInline " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HashableScriptData -> String
prettyScriptData HashableScriptData
scriptData
    TxOutDatum ctx Era
_ -> String -> String
forall a. HasCallStack => String -> a
error String
"absurd"

  prettyReferenceScript :: ReferenceScript Era -> String
prettyReferenceScript = \case
    ReferenceScript Era
Api.ReferenceScriptNone ->
      String
"ReferenceScriptNone"
    (Api.ReferenceScript (Api.ScriptInAnyLang ScriptLanguage lang
l Script lang
s)) ->
      String
"ReferenceScript " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ScriptLanguage lang -> String
forall a. Show a => a -> String
show ScriptLanguage lang
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show (ScriptHash -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText (Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
s))

  prettyDatumCtx :: TxOutDatum CtxTx -> String
prettyDatumCtx = \case
    TxOutDatum CtxTx
Api.TxOutDatumNone ->
      String
"TxOutDatumNone"
    Api.TxOutDatumHash Hash ScriptData
h ->
      String
"TxOutDatumHash " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Hash ScriptData -> String
forall a. Show a => a -> String
show Hash ScriptData
h
    Api.TxOutDatumInline HashableScriptData
scriptData ->
      String
"TxOutDatumInline " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HashableScriptData -> String
prettyScriptData HashableScriptData
scriptData
    Api.TxOutSupplementalDatum HashableScriptData
scriptData ->
      String
"TxOutSupplementalDatum " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HashableScriptData -> String
prettyScriptData HashableScriptData
scriptData

  scriptLines :: [String]
scriptLines =
    [ String
"== SCRIPTS (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([AlonzoScript ConwayEra] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AlonzoScript ConwayEra]
[Script LedgerEra]
scripts) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
    , String
"Total size (bytes):  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show Int64
totalScriptSize
    ]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ((String
"- " <>) (String -> String)
-> (Script ConwayEra -> String) -> Script ConwayEra -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script ConwayEra -> String
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraScript era) =>
Script era -> String
prettyScript (Script ConwayEra -> String) -> [Script ConwayEra] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Script LedgerEra]
[Script ConwayEra]
scripts)

  totalScriptSize :: Int64
totalScriptSize = [Int64] -> Int64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int64] -> Int64) -> [Int64] -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length (ByteString -> Int64)
-> (AlonzoScript ConwayEra -> ByteString)
-> AlonzoScript ConwayEra
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoScript ConwayEra -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize (AlonzoScript ConwayEra -> Int64)
-> [AlonzoScript ConwayEra] -> [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AlonzoScript ConwayEra]
[Script LedgerEra]
scripts

  prettyScript :: Script era -> String
prettyScript Script era
script =
    String
"Script (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> String
forall a. Show a => a -> String
show (Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
Ledger.hashScript Script era
script) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

  datumLines :: [String]
datumLines = case TxBodyScriptData
scriptsData of
    TxBodyScriptData
Api.TxBodyNoScriptData -> []
    (Api.TxBodyScriptData (Ledger.TxDats Map DataHash (Data ConwayEra)
dats) Redeemers LedgerEra
_) ->
      String
"== DATUMS (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Map DataHash (Data ConwayEra) -> Int
forall a. Map DataHash a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map DataHash (Data ConwayEra)
dats) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
        String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String
"- " <>) (String -> String)
-> ((DataHash, Data ConwayEra) -> String)
-> (DataHash, Data ConwayEra)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataHash, Data ConwayEra) -> String
forall {i} {era}. (SafeHash i, Data era) -> String
showDatumAndHash ((DataHash, Data ConwayEra) -> String)
-> [(DataHash, Data ConwayEra)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map DataHash (Data ConwayEra) -> [(DataHash, Data ConwayEra)]
forall k a. Map k a -> [(k, a)]
Map.toList Map DataHash (Data ConwayEra)
dats)

  showDatumAndHash :: (SafeHash i, Data era) -> String
showDatumAndHash (SafeHash i
k, Data era
v) =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ Hash HASH i -> String
forall a. Show a => a -> String
show (SafeHash i -> Hash HASH i
forall i. SafeHash i -> Hash HASH i
Ledger.extractHash SafeHash i
k)
      , String
"\n  "
      , HashableScriptData -> String
prettyScriptData (Data era -> HashableScriptData
forall era. Data era -> HashableScriptData
fromLedgerData Data era
v)
      ]

  prettyScriptData :: HashableScriptData -> String
prettyScriptData =
    Text -> String
T.unpack (Text -> String)
-> (HashableScriptData -> Text) -> HashableScriptData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (HashableScriptData -> ByteString) -> HashableScriptData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (HashableScriptData -> ByteString)
-> HashableScriptData
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> ByteString)
-> (HashableScriptData -> Value)
-> HashableScriptData
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDataJsonSchema -> HashableScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonNoSchema

  redeemerLines :: [String]
redeemerLines = case TxBodyScriptData
scriptsData of
    TxBodyScriptData
Api.TxBodyNoScriptData -> []
    (Api.TxBodyScriptData TxDats LedgerEra
_ Redeemers LedgerEra
re) ->
      let rdmrs :: [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
rdmrs = Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
 -> [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))])
-> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
forall a b. (a -> b) -> a -> b
$ Redeemers ConwayEra
-> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
Ledger.unRedeemers Redeemers LedgerEra
Redeemers ConwayEra
re
       in String
"== REDEEMERS (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
rdmrs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
            String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String
"- " <>) (String -> String)
-> ((PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))
    -> String)
-> (PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits)) -> String
forall {a} {era}. Show a => (a, (Data era, ExUnits)) -> String
prettyRedeemer ((PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))
 -> String)
-> [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
-> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
rdmrs)

  prettyRedeemer :: (a, (Data era, ExUnits)) -> String
prettyRedeemer (a
purpose, (Data era
redeemerData, ExUnits
redeemerBudget)) =
    [String] -> String
unwords
      [ a -> String
forall a. Show a => a -> String
show a
purpose
      , [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ String
"( cpu = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Nat -> String
forall a. Show a => a -> String
show (ExUnits -> Nat
Ledger.exUnitsSteps ExUnits
redeemerBudget)
          , String
", mem = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Nat -> String
forall a. Show a => a -> String
show (ExUnits -> Nat
Ledger.exUnitsMem ExUnits
redeemerBudget) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" )"
          ]
      , String
"\n  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HashableScriptData -> String
prettyScriptData (Data era -> HashableScriptData
forall era. Data era -> HashableScriptData
fromLedgerData Data era
redeemerData)
      ]

  requiredSignersLines :: [String]
requiredSignersLines =
    String
"== REQUIRED SIGNERS" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: case TxBodyContent ViewTx Era -> TxExtraKeyWitnesses Era
forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txExtraKeyWits TxBodyContent ViewTx Era
content of
      TxExtraKeyWitnesses Era
Api.TxExtraKeyWitnessesNone -> [String
"[]"]
      Api.TxExtraKeyWitnesses [Hash PaymentKey]
xs -> (String
"- " <>) (String -> String)
-> (Hash PaymentKey -> String) -> Hash PaymentKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash PaymentKey -> String
forall a. Show a => a -> String
show (Hash PaymentKey -> String) -> [Hash PaymentKey] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Hash PaymentKey]
xs

  metadataLines :: [String]
metadataLines =
    [ String
"== METADATA"
    , TxMetadataInEra Era -> String
forall a. Show a => a -> String
show (TxBodyContent ViewTx Era -> TxMetadataInEra Era
forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata TxBodyContent ViewTx Era
content)
    ]