{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}

module Convex.ThreatModel.Pretty where

import Cardano.Api hiding (Doc, (<+>))

-- import Cardano.Api.Byron hiding (Doc, (<+>))
import Cardano.Ledger.Alonzo.Tx qualified as Ledger (Data)
import Cardano.Ledger.Alonzo.TxWits qualified as Ledger

import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
import Cardano.Ledger.Conway.Scripts qualified as Conway
import Cardano.Ledger.Hashes qualified as Ledger
import Data.ByteString qualified as BS
import Data.Char
import Data.List (nub, sort)
import Data.Map qualified as Map
import GHC.Exts (toList)

import Text.PrettyPrint.HughesPJClass hiding ((<>))
import Text.Printf

import Convex.ThreatModel.Cardano.Api
import Convex.ThreatModel.TxModifier

{- | Format a list of strings as a paragraph. The structure of the list is not considered other than
  inserting whitespace between consecutive elements. Use with
  `Test.QuickCheck.ContractModel.ThreatModel.counterexampleTM`
  when printing longer texts.
-}
paragraph :: [String] -> String
paragraph :: [[Char]] -> [Char]
paragraph [[Char]]
s = Doc -> [Char]
forall a. Show a => a -> [Char]
show (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Doc] -> Doc
fsep ([Doc] -> Doc) -> ([[Char]] -> [Doc]) -> [[Char]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Doc) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
text ([[Char]] -> [Doc]) -> ([[Char]] -> [[Char]]) -> [[Char]] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words ([Char] -> [[Char]])
-> ([[Char]] -> [Char]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords ([[Char]] -> Doc) -> [[Char]] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Char]]
s) Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
""

block :: Doc -> [Doc] -> Doc
block :: Doc -> [Doc] -> Doc
block Doc
hd [Doc]
body = Doc
hd Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
vcat [Doc]
body)

fblock :: Doc -> [Doc] -> Doc
fblock :: Doc -> [Doc] -> Doc
fblock Doc
hd [Doc]
body = Doc -> Int -> Doc -> Doc
hang Doc
hd Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [Doc]
body

hblock :: Doc -> [Doc] -> Doc
hblock :: Doc -> [Doc] -> Doc
hblock Doc
hd [Doc]
body = Doc
hd Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep [Doc]
body

pList :: [Doc] -> Doc
pList :: [Doc] -> Doc
pList = Doc -> Doc
brackets (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

pSet :: [Doc] -> Doc
pSet :: [Doc] -> Doc
pSet = Doc -> Doc
braces (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

pArgs :: [Doc] -> Doc
pArgs :: [Doc] -> Doc
pArgs = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

infixr 6 <:>
(<:>) :: Doc -> Doc -> Doc
Doc
a <:> :: Doc -> Doc -> Doc
<:> Doc
b = (Doc
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
":") Doc -> Doc -> Doc
<+> Doc
b

prettyInput :: Input -> Doc
prettyInput :: Input -> Doc
prettyInput (Input TxOut CtxUTxO Era
txout TxIn
txin) =
  TxIn -> Doc
prettyIn TxIn
txin Doc -> Doc -> Doc
<:> TxOut CtxUTxO Era -> Doc
prettyTxOut TxOut CtxUTxO Era
txout

prettyOutput :: Output -> Doc
prettyOutput :: Output -> Doc
prettyOutput (Output TxOut CtxTx Era
txout (TxIx Word
i)) =
  Doc -> Doc
brackets ([Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Word -> [Char]
forall a. Show a => a -> [Char]
show Word
i) Doc -> Doc -> Doc
<:> TxOut CtxTx Era -> Doc
prettyTxOutTx TxOut CtxTx Era
txout

prettyUTxO :: UTxO Era -> Doc
prettyUTxO :: UTxO Era -> Doc
prettyUTxO (UTxO Map TxIn (TxOut CtxUTxO Era)
utxos) =
  Doc -> [Doc] -> Doc
block
    ([Char] -> Doc
text [Char]
"UTxOs")
    [ (TxIn -> Doc
prettyIn TxIn
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
":") Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
ind (TxOut CtxUTxO Era -> Doc
prettyTxOut TxOut CtxUTxO Era
o)
    | (TxIn
i, TxOut CtxUTxO Era
o) <- Map TxIn (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut CtxUTxO Era)
utxos
    ]
 where
  ind :: Int
ind
    | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Word
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
9 | TxIn TxId
_ (TxIx Word
i) <- Map TxIn (TxOut CtxUTxO Era) -> [TxIn]
forall k a. Map k a -> [k]
Map.keys Map TxIn (TxOut CtxUTxO Era)
utxos] = Int
13
    | Bool
otherwise = Int
12

prettyIn :: TxIn -> Doc
prettyIn :: TxIn -> Doc
prettyIn (TxIn TxId
hash TxIx
ix) =
  TxId -> Doc
forall a. Show a => a -> Doc
prettyHash TxId
hash Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (TxIx -> Doc
prettyIx TxIx
ix)

prettyTxOut :: TxOut CtxUTxO Era -> Doc
prettyTxOut :: TxOut CtxUTxO Era -> Doc
prettyTxOut (TxOut (AddressInEra AddressTypeInEra addrtype Era
_ Address addrtype
addr) TxOutValue Era
value TxOutDatum CtxUTxO Era
datum ReferenceScript Era
rscript) =
  Doc -> [Doc] -> Doc
hblock
    ([Char] -> Doc
text [Char]
"TxOut")
    [ AddressAny -> Doc
prettyAddress (Address addrtype -> AddressAny
forall addr. Address addr -> AddressAny
toAddressAny Address addrtype
addr)
    , Value -> Doc
prettyValue (TxOutValue Era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue Era
value)
    , Datum -> Doc
prettyDatum Datum
datum'
    , ReferenceScript Era -> Doc
prettyRefScript ReferenceScript Era
rscript
    ]
 where
  datum' :: Datum
datum' = case TxOutDatum CtxUTxO Era
datum of
    TxOutDatum CtxUTxO Era
TxOutDatumNone -> Datum
forall ctx era. TxOutDatum ctx era
TxOutDatumNone
    TxOutDatumHash AlonzoEraOnwards Era
s Hash ScriptData
h -> AlonzoEraOnwards Era -> Hash ScriptData -> Datum
forall era ctx.
AlonzoEraOnwards era -> Hash ScriptData -> TxOutDatum ctx era
TxOutDatumHash AlonzoEraOnwards Era
s Hash ScriptData
h
    TxOutDatumInline BabbageEraOnwards Era
s HashableScriptData
sd -> BabbageEraOnwards Era -> HashableScriptData -> Datum
forall era ctx.
BabbageEraOnwards era -> HashableScriptData -> TxOutDatum ctx era
TxOutDatumInline BabbageEraOnwards Era
s HashableScriptData
sd

prettyTxOutTx :: TxOut CtxTx Era -> Doc
prettyTxOutTx :: TxOut CtxTx Era -> Doc
prettyTxOutTx (TxOut (AddressInEra AddressTypeInEra addrtype Era
_ Address addrtype
addr) TxOutValue Era
value Datum
datum ReferenceScript Era
rscript) =
  Doc -> [Doc] -> Doc
hblock
    ([Char] -> Doc
text [Char]
"TxOut")
    [ AddressAny -> Doc
prettyAddress (Address addrtype -> AddressAny
forall addr. Address addr -> AddressAny
toAddressAny Address addrtype
addr)
    , Value -> Doc
prettyValue (TxOutValue Era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue Era
value)
    , Datum -> Doc
prettyDatum Datum
datum
    , ReferenceScript Era -> Doc
prettyRefScript ReferenceScript Era
rscript
    ]

prettyAddress :: AddressAny -> Doc
prettyAddress :: AddressAny -> Doc
prettyAddress (AddressByron (ByronAddress Address
a)) = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Address -> [Char]
forall a. Show a => a -> [Char]
show Address
a
prettyAddress (AddressShelley (ShelleyAddress Network
_ PaymentCredential
c StakeReference
_)) =
  case PaymentCredential -> PaymentCredential
fromShelleyPaymentCredential PaymentCredential
c of
    PaymentCredentialByKey Hash PaymentKey
h -> [Char] -> Doc
text [Char]
"Key#" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Hash PaymentKey -> Doc
forall a. Show a => a -> Doc
prettyHash Hash PaymentKey
h
    PaymentCredentialByScript ScriptHash
h -> [Char] -> Doc
text [Char]
"Script#" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> Doc
forall a. Show a => a -> Doc
prettyHash ScriptHash
h

prettyIx :: TxIx -> Doc
prettyIx :: TxIx -> Doc
prettyIx (TxIx Word
txIx) = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Word -> [Char]
forall a. Show a => a -> [Char]
show Word
txIx

prettyValue :: Value -> Doc
prettyValue :: Value -> Doc
prettyValue Value
value =
  [Doc] -> Doc
pSet
    [ AssetId -> Doc
prettyAssetId AssetId
assetId Doc -> Doc -> Doc
<:> [Char] -> Doc
text (Quantity -> [Char]
forall a. Show a => a -> [Char]
show Quantity
num)
    | (AssetId
assetId, Quantity
num) <- Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList Value
value
    ]

prettyAssetId :: AssetId -> Doc
prettyAssetId :: AssetId -> Doc
prettyAssetId AssetId
AdaAssetId = [Char] -> Doc
text [Char]
"lovelace"
prettyAssetId (AssetId PolicyId
hash AssetName
name) = PolicyId -> Doc
forall a. Show a => a -> Doc
prettyHash PolicyId
hash Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> AssetName -> Doc
forall {a}. SerialiseAsRawBytes a => a -> Doc
prettyName AssetName
name
 where
  prettyName :: a -> Doc
prettyName a
n = Bool -> ByteString -> Doc
prettyBytes Bool
False (a -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes a
n)

prettyHash :: (Show a) => a -> Doc
prettyHash :: forall a. Show a => a -> Doc
prettyHash = [Char] -> Doc
text ([Char] -> Doc) -> (a -> [Char]) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
7 ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

prettyDatum :: Datum -> Doc
prettyDatum :: Datum -> Doc
prettyDatum Datum
TxOutDatumNone = [Char] -> Doc
text [Char]
"Datum#None"
prettyDatum (TxOutDatumHash AlonzoEraOnwards Era
_ Hash ScriptData
h) = [Char] -> Doc
text [Char]
"Datum#" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Hash ScriptData -> Doc
forall a. Show a => a -> Doc
prettyHash Hash ScriptData
h
prettyDatum (TxOutDatumInline BabbageEraOnwards Era
_ HashableScriptData
d) = ScriptData -> Doc
prettyScriptData (ScriptData -> Doc) -> ScriptData -> Doc
forall a b. (a -> b) -> a -> b
$ HashableScriptData -> ScriptData
getScriptData HashableScriptData
d
prettyDatum (TxOutSupplementalDatum AlonzoEraOnwards Era
_ HashableScriptData
d) = ScriptData -> Doc
prettyScriptData (ScriptData -> Doc) -> ScriptData -> Doc
forall a b. (a -> b) -> a -> b
$ HashableScriptData -> ScriptData
getScriptData HashableScriptData
d

prettyRefScript :: ReferenceScript Era -> Doc
prettyRefScript :: ReferenceScript Era -> Doc
prettyRefScript ReferenceScript Era
ReferenceScriptNone = [Char] -> Doc
text [Char]
"RefScript#None"
prettyRefScript (ReferenceScript BabbageEraOnwards Era
_ ScriptInAnyLang
s) = [Char] -> Doc
text [Char]
"RefScript#" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ScriptInAnyLang -> Doc
prettyScript ScriptInAnyLang
s

prettyScript :: ScriptInAnyLang -> Doc
prettyScript :: ScriptInAnyLang -> Doc
prettyScript (ScriptInAnyLang ScriptLanguage lang
_ Script lang
s) = ScriptHash -> Doc
forall a. Show a => a -> Doc
prettyHash (Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
s)

prettyTx :: Tx Era -> Doc
prettyTx :: Tx Era -> Doc
prettyTx tx :: Tx Era
tx@(Tx TxBody Era
body [KeyWitness Era]
_) =
  Doc -> [Doc] -> Doc
block ([Char] -> Doc
text [Char]
"Tx") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
    [ [Char] -> Doc
text [Char]
"Valid:" Doc -> Doc -> Doc
<+> (TxValidityLowerBound Era, TxValidityUpperBound Era) -> Doc
prettyValidity (TxValidityLowerBound Era
txValidityLowerBound, TxValidityUpperBound Era
txValidityUpperBound)
    , Doc -> [Doc] -> Doc
fblock ([Char] -> Doc
text [Char]
"Inputs:") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (TxIn -> Doc) -> [TxIn] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> Doc
prettyIn [TxIn]
inps
    ]
      [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [ Doc -> [Doc] -> Doc
fblock ([Char] -> Doc
text [Char]
"Reference inputs:") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (TxIn -> Doc) -> [TxIn] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> Doc
prettyIn [TxIn]
refinps
         | TxInsReference BabbageEraOnwards Era
_ [TxIn]
refinps TxInsReferenceDatums ViewTx
_ <- [TxInsReference ViewTx Era
txInsReference]
         ]
      [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [ Doc -> [Doc] -> Doc
block
             ([Char] -> Doc
text [Char]
"Outputs:")
             [ Int -> Doc
int Int
i Doc -> Doc -> Doc
<:> TxOut CtxTx Era -> Doc
prettyTxOutTx TxOut CtxTx Era
out
             | (Int
i, TxOut CtxTx Era
out) <- [Int] -> [TxOut CtxTx Era] -> [(Int, TxOut CtxTx Era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [TxOut CtxTx Era]
txOuts
             ]
         , TxMintValue ViewTx Era -> Doc
forall build. TxMintValue build Era -> Doc
prettyMinting TxMintValue ViewTx Era
txMintValue
         , TxBodyScriptData Era -> Doc
prettyDatumMap TxBodyScriptData Era
scriptdat
         , Doc -> [Doc] -> Doc
block ([Char] -> Doc
text [Char]
"Redeemers:") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((ConwayPlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))
 -> Doc)
-> [(ConwayPlutusPurpose AsIx ConwayEra,
     (Data ConwayEra, ExUnits))]
-> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((PlutusPurpose AsIx LedgerEra -> (Data LedgerEra, ExUnits) -> Doc)
-> (PlutusPurpose AsIx LedgerEra, (Data LedgerEra, ExUnits)) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((PlutusPurpose AsIx LedgerEra -> (Data LedgerEra, ExUnits) -> Doc)
 -> (PlutusPurpose AsIx LedgerEra, (Data LedgerEra, ExUnits))
 -> Doc)
-> (PlutusPurpose AsIx LedgerEra
    -> (Data LedgerEra, ExUnits) -> Doc)
-> (PlutusPurpose AsIx LedgerEra, (Data LedgerEra, ExUnits))
-> Doc
forall a b. (a -> b) -> a -> b
$ [TxIn]
-> [PolicyId]
-> PlutusPurpose AsIx LedgerEra
-> (Data LedgerEra, ExUnits)
-> Doc
prettyRedeemer [TxIn]
inps [PolicyId]
mnts) ([(ConwayPlutusPurpose AsIx ConwayEra, (Data ConwayEra, ExUnits))]
 -> [Doc])
-> [(ConwayPlutusPurpose AsIx ConwayEra,
     (Data ConwayEra, ExUnits))]
-> [Doc]
forall a b. (a -> b) -> a -> b
$ Map (ConwayPlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> [(ConwayPlutusPurpose AsIx ConwayEra,
     (Data ConwayEra, ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (ConwayPlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
rdmrs
         , Doc -> [Doc] -> Doc
block ([Char] -> Doc
text [Char]
"Signed by:") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Hash PaymentKey -> Doc) -> [Hash PaymentKey] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Hash PaymentKey -> Doc
forall a. Show a => a -> Doc
prettyHash (Tx Era -> [Hash PaymentKey]
txSigners Tx Era
tx)
         ]
 where
  TxBodyContent{TxIns ViewTx Era
[TxOut CtxTx Era]
Maybe (Featured ConwayEraOnwards Era (Maybe Coin))
Maybe (Featured ConwayEraOnwards Era Coin)
Maybe
  (Featured ConwayEraOnwards Era (TxProposalProcedures ViewTx Era))
Maybe
  (Featured ConwayEraOnwards Era (TxVotingProcedures ViewTx Era))
BuildTxWith ViewTx (Maybe (LedgerProtocolParameters Era))
TxScriptValidity Era
TxAuxScripts Era
TxCertificates ViewTx Era
TxExtraKeyWitnesses Era
TxFee Era
TxInsCollateral Era
TxInsReference ViewTx Era
TxMetadataInEra Era
TxMintValue ViewTx Era
TxReturnCollateral CtxTx Era
TxTotalCollateral Era
TxUpdateProposal Era
TxValidityLowerBound Era
TxValidityUpperBound Era
TxWithdrawals ViewTx Era
txValidityLowerBound :: TxValidityLowerBound Era
txValidityUpperBound :: TxValidityUpperBound Era
txInsReference :: TxInsReference ViewTx Era
txOuts :: [TxOut CtxTx Era]
txMintValue :: TxMintValue ViewTx Era
txIns :: TxIns ViewTx Era
txInsCollateral :: TxInsCollateral Era
txTotalCollateral :: TxTotalCollateral Era
txReturnCollateral :: TxReturnCollateral CtxTx Era
txFee :: TxFee Era
txMetadata :: TxMetadataInEra Era
txAuxScripts :: TxAuxScripts Era
txExtraKeyWits :: TxExtraKeyWitnesses Era
txProtocolParams :: BuildTxWith ViewTx (Maybe (LedgerProtocolParameters Era))
txWithdrawals :: TxWithdrawals ViewTx Era
txCertificates :: TxCertificates ViewTx Era
txUpdateProposal :: TxUpdateProposal Era
txScriptValidity :: TxScriptValidity Era
txProposalProcedures :: Maybe
  (Featured ConwayEraOnwards Era (TxProposalProcedures ViewTx Era))
txVotingProcedures :: Maybe
  (Featured ConwayEraOnwards Era (TxVotingProcedures ViewTx Era))
txCurrentTreasuryValue :: Maybe (Featured ConwayEraOnwards Era (Maybe Coin))
txTreasuryDonation :: Maybe (Featured ConwayEraOnwards Era Coin)
txAuxScripts :: forall build era. TxBodyContent build era -> TxAuxScripts era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCurrentTreasuryValue :: forall build era.
TxBodyContent build era
-> Maybe (Featured ConwayEraOnwards era (Maybe Coin))
txExtraKeyWits :: forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txFee :: forall build era. TxBodyContent build era -> TxFee era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txInsCollateral :: forall build era. TxBodyContent build era -> TxInsCollateral era
txInsReference :: forall build era.
TxBodyContent build era -> TxInsReference build era
txMetadata :: forall build era. TxBodyContent build era -> TxMetadataInEra era
txMintValue :: forall build era. TxBodyContent build era -> TxMintValue build era
txOuts :: forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txProposalProcedures :: forall build era.
TxBodyContent build era
-> Maybe
     (Featured ConwayEraOnwards era (TxProposalProcedures build era))
txProtocolParams :: forall build era.
TxBodyContent build era
-> BuildTxWith build (Maybe (LedgerProtocolParameters era))
txReturnCollateral :: forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txScriptValidity :: forall build era. TxBodyContent build era -> TxScriptValidity era
txTotalCollateral :: forall build era. TxBodyContent build era -> TxTotalCollateral era
txTreasuryDonation :: forall build era.
TxBodyContent build era
-> Maybe (Featured ConwayEraOnwards era Coin)
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txValidityLowerBound :: forall build era.
TxBodyContent build era -> TxValidityLowerBound era
txValidityUpperBound :: forall build era.
TxBodyContent build era -> TxValidityUpperBound era
txVotingProcedures :: forall build era.
TxBodyContent build era
-> Maybe
     (Featured ConwayEraOnwards era (TxVotingProcedures build era))
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
..} = TxBody Era -> TxBodyContent ViewTx Era
forall era. TxBody era -> TxBodyContent ViewTx era
getTxBodyContent TxBody Era
body
  ShelleyTxBody ShelleyBasedEra Era
_ TxBody LedgerEra
_ [Script LedgerEra]
_ TxBodyScriptData Era
scriptdat Maybe (TxAuxData LedgerEra)
_ TxScriptValidity Era
_ = TxBody Era
body
  inps :: [TxIn]
inps = [TxIn] -> [TxIn]
forall a. Ord a => [a] -> [a]
sort ([TxIn] -> [TxIn])
-> (TxIns ViewTx Era -> [TxIn]) -> TxIns ViewTx Era -> [TxIn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> TxIn)
-> TxIns ViewTx Era -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn Era)) -> TxIn
forall a b. (a, b) -> a
fst (TxIns ViewTx Era -> [TxIn]) -> TxIns ViewTx Era -> [TxIn]
forall a b. (a -> b) -> a -> b
$ TxIns ViewTx Era
txIns
  mnts :: [PolicyId]
mnts = case TxMintValue ViewTx Era
txMintValue of
    TxMintValue ViewTx Era
TxMintNone -> []
    TxMintValue{} -> [PolicyId
hash | AssetId PolicyId
hash AssetName
_ <- [AssetId] -> [AssetId]
forall a. Ord a => [a] -> [a]
sort ([AssetId] -> [AssetId])
-> ([(AssetId, Quantity)] -> [AssetId])
-> [(AssetId, Quantity)]
-> [AssetId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AssetId] -> [AssetId]
forall a. Eq a => [a] -> [a]
nub ([AssetId] -> [AssetId])
-> ([(AssetId, Quantity)] -> [AssetId])
-> [(AssetId, Quantity)]
-> [AssetId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AssetId, Quantity) -> AssetId)
-> [(AssetId, Quantity)] -> [AssetId]
forall a b. (a -> b) -> [a] -> [b]
map (AssetId, Quantity) -> AssetId
forall a b. (a, b) -> a
fst ([(AssetId, Quantity)] -> [AssetId])
-> [(AssetId, Quantity)] -> [AssetId]
forall a b. (a -> b) -> a -> b
$ Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList (TxMintValue ViewTx Era -> Value
forall build era. TxMintValue build era -> Value
txMintValueToValue TxMintValue ViewTx Era
txMintValue)]
  rdmrs :: Map (ConwayPlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
rdmrs = case TxBodyScriptData Era
scriptdat of
    TxBodyScriptData AlonzoEraOnwards Era
_ TxDats LedgerEra
_ (Ledger.Redeemers Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
rdmrs') -> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
Map (ConwayPlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
rdmrs'
    TxBodyScriptData Era
TxBodyNoScriptData -> Map (ConwayPlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall a. Monoid a => a
mempty

prettyRedeemer :: [TxIn] -> [PolicyId] -> Ledger.PlutusPurpose Ledger.AsIx LedgerEra -> (Ledger.Data LedgerEra, Ledger.ExUnits) -> Doc
prettyRedeemer :: [TxIn]
-> [PolicyId]
-> PlutusPurpose AsIx LedgerEra
-> (Data LedgerEra, ExUnits)
-> Doc
prettyRedeemer [TxIn]
inps [PolicyId]
mints PlutusPurpose AsIx LedgerEra
purpose (Data LedgerEra
dat, ExUnits
_) = Doc
pTag Doc -> Doc -> Doc
<:> ScriptData -> Doc
prettyScriptData (HashableScriptData -> ScriptData
getScriptData (HashableScriptData -> ScriptData)
-> HashableScriptData -> ScriptData
forall a b. (a -> b) -> a -> b
$ Data ConwayEra -> HashableScriptData
forall ledgerera. Data ledgerera -> HashableScriptData
fromAlonzoData Data LedgerEra
Data ConwayEra
dat)
 where
  pTag :: Doc
pTag =
    case PlutusPurpose AsIx LedgerEra
purpose of
      Conway.ConwaySpending (Ledger.AsIx Word32
ix) -> [Char] -> Doc
text [Char]
"Spend" Doc -> Doc -> Doc
<+> TxIn -> Doc
prettyIn ([TxIn]
inps [TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ix)
      Conway.ConwayMinting (Ledger.AsIx Word32
ix) -> [Char] -> Doc
text [Char]
"Mint" Doc -> Doc -> Doc
<+> PolicyId -> Doc
forall a. Show a => a -> Doc
prettyHash ([PolicyId]
mints [PolicyId] -> Int -> PolicyId
forall a. HasCallStack => [a] -> Int -> a
!! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ix)
      Conway.ConwayCertifying AsIx Word32 (TxCert ConwayEra)
_ -> [Char] -> Doc
text [Char]
"Certify"
      Conway.ConwayRewarding AsIx Word32 RewardAccount
_ -> [Char] -> Doc
text [Char]
"Reward"
      Conway.ConwayVoting AsIx Word32 Voter
_ -> [Char] -> Doc
text [Char]
"Vote"
      Conway.ConwayProposing AsIx Word32 (ProposalProcedure ConwayEra)
_ -> [Char] -> Doc
text [Char]
"Propose"

prettyDatumMap :: TxBodyScriptData Era -> Doc
prettyDatumMap :: TxBodyScriptData Era -> Doc
prettyDatumMap (TxBodyScriptData AlonzoEraOnwards Era
_ (Ledger.TxDats Map DataHash (Data ConwayEra)
dats) Redeemers LedgerEra
_)
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map DataHash (Data ConwayEra) -> Bool
forall a. Map DataHash a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map DataHash (Data ConwayEra)
dats =
      Doc -> [Doc] -> Doc
block
        ([Char] -> Doc
text [Char]
"Datums:")
        [ Hash HASH EraIndependentData -> Doc
forall a. Show a => a -> Doc
prettyHash (DataHash -> Hash HASH EraIndependentData
forall i. SafeHash i -> Hash HASH i
Ledger.extractHash DataHash
key)
            Doc -> Doc -> Doc
<:> ScriptData -> Doc
prettyScriptData (HashableScriptData -> ScriptData
getScriptData (HashableScriptData -> ScriptData)
-> HashableScriptData -> ScriptData
forall a b. (a -> b) -> a -> b
$ Data ConwayEra -> HashableScriptData
forall ledgerera. Data ledgerera -> HashableScriptData
fromAlonzoData Data ConwayEra
val)
        | (DataHash
key, Data ConwayEra
val) <- Map DataHash (Data ConwayEra) -> [(DataHash, Data ConwayEra)]
forall k a. Map k a -> [(k, a)]
Map.toList Map DataHash (Data ConwayEra)
dats
        ]
prettyDatumMap TxBodyScriptData Era
_ = Doc
empty

prettyMinting :: TxMintValue build Era -> Doc
prettyMinting :: forall build. TxMintValue build Era -> Doc
prettyMinting TxMintValue build Era
TxMintNone = Doc
empty
prettyMinting mv :: TxMintValue build Era
mv@TxMintValue{} = Doc -> [Doc] -> Doc
block ([Char] -> Doc
text [Char]
"Minting:") [Value -> Doc
prettyValue (TxMintValue build Era -> Value
forall build era. TxMintValue build era -> Value
txMintValueToValue TxMintValue build Era
mv)]

prettyValidity :: (TxValidityLowerBound Era, TxValidityUpperBound Era) -> Doc
prettyValidity :: (TxValidityLowerBound Era, TxValidityUpperBound Era) -> Doc
prettyValidity (TxValidityLowerBound Era
lo, TxValidityUpperBound Era
hi) = TxValidityLowerBound Era -> Doc
prettyLowerBound TxValidityLowerBound Era
lo Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"-" Doc -> Doc -> Doc
<+> TxValidityUpperBound Era -> Doc
prettyUpperBound TxValidityUpperBound Era
hi

prettyLowerBound :: TxValidityLowerBound Era -> Doc
prettyLowerBound :: TxValidityLowerBound Era -> Doc
prettyLowerBound TxValidityLowerBound Era
TxValidityNoLowerBound = [Char] -> Doc
text [Char]
"-∞"
prettyLowerBound (TxValidityLowerBound AllegraEraOnwards Era
_ SlotNo
slot) = [Char] -> Doc
text (Word64 -> [Char]
forall a. Show a => a -> [Char]
show (Word64 -> [Char]) -> Word64 -> [Char]
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
slot)

prettyUpperBound :: TxValidityUpperBound Era -> Doc
prettyUpperBound :: TxValidityUpperBound Era -> Doc
prettyUpperBound (TxValidityUpperBound ShelleyBasedEra Era
_ Maybe SlotNo
Nothing) = [Char] -> Doc
text [Char]
"∞"
prettyUpperBound (TxValidityUpperBound ShelleyBasedEra Era
_ (Just SlotNo
slot)) = [Char] -> Doc
text (Word64 -> [Char]
forall a. Show a => a -> [Char]
show (Word64 -> [Char]) -> Word64 -> [Char]
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
slot)

prettyPlutusScript :: (IsPlutusScriptLanguage lang) => PlutusScript lang -> Doc
prettyPlutusScript :: forall lang.
IsPlutusScriptLanguage lang =>
PlutusScript lang -> Doc
prettyPlutusScript = ScriptHash -> Doc
forall a. Show a => a -> Doc
prettyHash (ScriptHash -> Doc)
-> (PlutusScript lang -> ScriptHash) -> PlutusScript lang -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script lang -> ScriptHash)
-> (PlutusScript lang -> Script lang)
-> PlutusScript lang
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
plutusScriptVersion

prettySimpleScript :: SimpleScript -> Doc
prettySimpleScript :: SimpleScript -> Doc
prettySimpleScript = ScriptHash -> Doc
forall a. Show a => a -> Doc
prettyHash (ScriptHash -> Doc)
-> (SimpleScript -> ScriptHash) -> SimpleScript -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script SimpleScript' -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script SimpleScript' -> ScriptHash)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript

prettyTxModifier :: TxModifier -> Doc
prettyTxModifier :: TxModifier -> Doc
prettyTxModifier (TxModifier [TxMod]
txmod) = [Doc] -> Doc
vcat [TxMod -> Doc
prettyMod TxMod
m | TxMod
m <- [TxMod]
txmod]
 where
  maybeBlock :: Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock Doc
_ Doc
_ t -> Doc
_ Maybe t
Nothing = Doc
empty
  maybeBlock Doc
tag Doc
hd t -> Doc
pr (Just t
d) = Doc -> Int -> Doc -> Doc
hang Doc
tag Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [Doc
hd, t -> Doc
pr t
d]

  prettyMod :: TxMod -> Doc
prettyMod (RemoveInput TxIn
txIn) =
    [Char] -> Doc
text [Char]
"removeInput" Doc -> Doc -> Doc
<+> TxIn -> Doc
prettyIn TxIn
txIn
  prettyMod (RemoveOutput TxIx
ix) =
    [Char] -> Doc
text [Char]
"removeOutput" Doc -> Doc -> Doc
<+> TxIx -> Doc
prettyIx TxIx
ix
  prettyMod (ChangeOutput TxIx
ix Maybe AddressAny
maddr Maybe Value
mvalue Maybe Datum
mdatum Maybe (ReferenceScript Era)
mrefscript) =
    [Doc] -> Doc
vcat
      [ Doc -> Doc -> (AddressAny -> Doc) -> Maybe AddressAny -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeAddressOf") (TxIx -> Doc
prettyIx TxIx
ix) AddressAny -> Doc
prettyAddress Maybe AddressAny
maddr
      , Doc -> Doc -> (Value -> Doc) -> Maybe Value -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeValueOf") (TxIx -> Doc
prettyIx TxIx
ix) Value -> Doc
prettyValue Maybe Value
mvalue
      , Doc -> Doc -> (Datum -> Doc) -> Maybe Datum -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeDatumOf") (TxIx -> Doc
prettyIx TxIx
ix) Datum -> Doc
prettyDatum Maybe Datum
mdatum
      , Doc
-> Doc
-> (ReferenceScript Era -> Doc)
-> Maybe (ReferenceScript Era)
-> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeRefScriptOf") (TxIx -> Doc
prettyIx TxIx
ix) ReferenceScript Era -> Doc
prettyRefScript Maybe (ReferenceScript Era)
mrefscript
      ]
  prettyMod (ChangeInput TxIn
txIn Maybe AddressAny
maddr Maybe Value
mvalue Maybe Datum
mdatum Maybe (ReferenceScript Era)
mrefscript) =
    [Doc] -> Doc
vcat
      [ Doc -> Doc -> (AddressAny -> Doc) -> Maybe AddressAny -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeAddressOf") (TxIn -> Doc
prettyIn TxIn
txIn) AddressAny -> Doc
prettyAddress Maybe AddressAny
maddr
      , Doc -> Doc -> (Value -> Doc) -> Maybe Value -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeValueOf") (TxIn -> Doc
prettyIn TxIn
txIn) Value -> Doc
prettyValue Maybe Value
mvalue
      , Doc -> Doc -> (Datum -> Doc) -> Maybe Datum -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeDatumOf") (TxIn -> Doc
prettyIn TxIn
txIn) Datum -> Doc
prettyDatum Maybe Datum
mdatum
      , Doc
-> Doc
-> (ReferenceScript Era -> Doc)
-> Maybe (ReferenceScript Era)
-> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeRefScriptOf") (TxIn -> Doc
prettyIn TxIn
txIn) ReferenceScript Era -> Doc
prettyRefScript Maybe (ReferenceScript Era)
mrefscript
      ]
  prettyMod (ChangeScriptInput TxIn
txIn Maybe Value
mvalue Maybe Datum
mdatum Maybe ScriptData
mrdmr Maybe (ReferenceScript Era)
mrefscript) =
    [Doc] -> Doc
vcat
      [ Doc -> Doc -> (Value -> Doc) -> Maybe Value -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeValueOf") (TxIn -> Doc
prettyIn TxIn
txIn) Value -> Doc
prettyValue Maybe Value
mvalue
      , Doc -> Doc -> (Datum -> Doc) -> Maybe Datum -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeDatumOf") (TxIn -> Doc
prettyIn TxIn
txIn) Datum -> Doc
prettyDatum Maybe Datum
mdatum
      , Doc -> Doc -> (ScriptData -> Doc) -> Maybe ScriptData -> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeRedeemerOf") (TxIn -> Doc
prettyIn TxIn
txIn) ScriptData -> Doc
prettyScriptData Maybe ScriptData
mrdmr
      , Doc
-> Doc
-> (ReferenceScript Era -> Doc)
-> Maybe (ReferenceScript Era)
-> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeRefScriptOf") (TxIn -> Doc
prettyIn TxIn
txIn) ReferenceScript Era -> Doc
prettyRefScript Maybe (ReferenceScript Era)
mrefscript
      ]
  prettyMod (AddOutput AddressAny
addr Value
value Datum
datum ReferenceScript Era
refscript) =
    Doc -> [Doc] -> Doc
fblock
      ([Char] -> Doc
text [Char]
"addOutput")
      [ AddressAny -> Doc
prettyAddress AddressAny
addr
      , Value -> Doc
prettyValue Value
value
      , Datum -> Doc
prettyDatum Datum
datum
      , ReferenceScript Era -> Doc
prettyRefScript ReferenceScript Era
refscript
      ]
  prettyMod (AddInput AddressAny
addr Value
value Datum
datum ReferenceScript Era
rscript Bool
isReferenceInput) =
    Doc -> [Doc] -> Doc
fblock
      ([Char] -> Doc
text [Char]
"add" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
input)
      [ AddressAny -> Doc
prettyAddress AddressAny
addr
      , Value -> Doc
prettyValue Value
value
      , Datum -> Doc
prettyDatum Datum
datum
      , ReferenceScript Era -> Doc
prettyRefScript ReferenceScript Era
rscript
      ]
   where
    input :: Doc
input
      | Bool
isReferenceInput = [Char] -> Doc
text [Char]
"ReferenceInput"
      | Bool
otherwise = [Char] -> Doc
text [Char]
"Input"
  prettyMod (AddPlutusScriptInput PlutusScript lang
script Value
value Datum
datum ScriptData
redeemer ReferenceScript Era
rscript) =
    Doc -> [Doc] -> Doc
fblock
      ([Char] -> Doc
text [Char]
"addPlutusScriptInput")
      [ PlutusScript lang -> Doc
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScript lang -> Doc
prettyPlutusScript PlutusScript lang
script
      , Value -> Doc
prettyValue Value
value
      , Datum -> Doc
prettyDatum Datum
datum
      , ScriptData -> Doc
prettyScriptData ScriptData
redeemer
      , ReferenceScript Era -> Doc
prettyRefScript ReferenceScript Era
rscript
      ]
  prettyMod (AddReferenceScriptInput ScriptHash
script Value
value Datum
datum ScriptData
redeemer) =
    Doc -> [Doc] -> Doc
fblock
      ([Char] -> Doc
text [Char]
"addReferenceScriptInput")
      [ ScriptHash -> Doc
forall a. Show a => a -> Doc
prettyHash ScriptHash
script
      , Value -> Doc
prettyValue Value
value
      , Datum -> Doc
prettyDatum Datum
datum
      , ScriptData -> Doc
prettyScriptData ScriptData
redeemer
      ]
  prettyMod (AddPlutusScriptReferenceInput PlutusScript lang
script Value
value Datum
datum ReferenceScript Era
rscript) =
    Doc -> [Doc] -> Doc
fblock
      ([Char] -> Doc
text [Char]
"addPlutusScriptReferenceInput")
      [ PlutusScript lang -> Doc
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScript lang -> Doc
prettyPlutusScript PlutusScript lang
script
      , Value -> Doc
prettyValue Value
value
      , Datum -> Doc
prettyDatum Datum
datum
      , ReferenceScript Era -> Doc
prettyRefScript ReferenceScript Era
rscript
      ]
  prettyMod (AddSimpleScriptInput SimpleScript
script Value
value ReferenceScript Era
rscript Bool
isReferenceInput) =
    Doc -> [Doc] -> Doc
fblock
      ([Char] -> Doc
text [Char]
"addSimpleScript" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
input)
      [ SimpleScript -> Doc
prettySimpleScript SimpleScript
script
      , Value -> Doc
prettyValue Value
value
      , ReferenceScript Era -> Doc
prettyRefScript ReferenceScript Era
rscript
      ]
   where
    input :: Doc
input
      | Bool
isReferenceInput = [Char] -> Doc
text [Char]
"ReferenceInput"
      | Bool
otherwise = [Char] -> Doc
text [Char]
"Input"
  prettyMod (ChangeValidityRange (Just TxValidityLowerBound Era
lo) (Just TxValidityUpperBound Era
hi)) =
    Doc -> [Doc] -> Doc
fblock ([Char] -> Doc
text [Char]
"changeValidityRange") [(TxValidityLowerBound Era, TxValidityUpperBound Era) -> Doc
prettyValidity (TxValidityLowerBound Era
lo, TxValidityUpperBound Era
hi)]
  prettyMod (ChangeValidityRange Maybe (TxValidityLowerBound Era)
mlo Maybe (TxValidityUpperBound Era)
mhi) =
    [Doc] -> Doc
vcat
      [ Doc
-> Doc
-> (TxValidityLowerBound Era -> Doc)
-> Maybe (TxValidityLowerBound Era)
-> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeValidityLowerBound") Doc
empty TxValidityLowerBound Era -> Doc
prettyLowerBound Maybe (TxValidityLowerBound Era)
mlo
      , Doc
-> Doc
-> (TxValidityUpperBound Era -> Doc)
-> Maybe (TxValidityUpperBound Era)
-> Doc
forall {t}. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock ([Char] -> Doc
text [Char]
"changeValidityUpperBound") Doc
empty TxValidityUpperBound Era -> Doc
prettyUpperBound Maybe (TxValidityUpperBound Era)
mhi
      ]
  prettyMod (AddPlutusScriptMint PlutusScript lang
script AssetName
assetName Quantity
quantity ScriptData
redeemer) =
    Doc -> [Doc] -> Doc
fblock
      ([Char] -> Doc
text [Char]
"addPlutusScriptMint")
      [ PlutusScript lang -> Doc
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScript lang -> Doc
prettyPlutusScript PlutusScript lang
script
      , [Char] -> Doc
text (AssetName -> [Char]
forall a. Show a => a -> [Char]
show AssetName
assetName)
      , [Char] -> Doc
text (Quantity -> [Char]
forall a. Show a => a -> [Char]
show Quantity
quantity)
      , ScriptData -> Doc
prettyScriptData ScriptData
redeemer
      ]
  prettyMod (RemoveRequiredSigner Hash PaymentKey
signer) =
    [Char] -> Doc
text [Char]
"removeRequiredSigner" Doc -> Doc -> Doc
<+> Hash PaymentKey -> Doc
forall a. Show a => a -> Doc
prettyHash Hash PaymentKey
signer
  prettyMod (ReplaceTx Tx Era
tx UTxO Era
utxos) =
    Doc -> [Doc] -> Doc
fblock
      ([Char] -> Doc
text [Char]
"replaceTx")
      [ UTxO Era -> Doc
prettyUTxO UTxO Era
utxos
      , Tx Era -> Doc
prettyTx Tx Era
tx
      ]

prettyScriptData :: ScriptData -> Doc
prettyScriptData :: ScriptData -> Doc
prettyScriptData (ScriptDataConstructor Integer
i [ScriptData]
args) = [Char] -> Doc
text [Char]
"Con" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
pArgs ((ScriptData -> Doc) -> [ScriptData] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Doc
prettyScriptData [ScriptData]
args)
prettyScriptData (ScriptDataMap [(ScriptData, ScriptData)]
map') =
  [Doc] -> Doc
pSet
    [ScriptData -> Doc
prettyScriptData ScriptData
k Doc -> Doc -> Doc
<:> ScriptData -> Doc
prettyScriptData ScriptData
v | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
map']
prettyScriptData (ScriptDataList [ScriptData]
list) = [Doc] -> Doc
pList ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ScriptData -> Doc) -> [ScriptData] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Doc
prettyScriptData [ScriptData]
list
prettyScriptData (ScriptDataNumber Integer
n) = [Char] -> Doc
text (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
n)
prettyScriptData (ScriptDataBytes ByteString
bs) = Bool -> ByteString -> Doc
prettyBytes Bool
True ByteString
bs

prettyBytes :: Bool -> BS.ByteString -> Doc
prettyBytes :: Bool -> ByteString -> Doc
prettyBytes Bool
quotes' ByteString
bs
  | Bool -> Bool
not ((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPrint [Char]
s) = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
7 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%02x" (Int -> [Char]) -> (Char -> Int) -> Char -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) [Char]
s
  | Bool
quotes' = [Char] -> Doc
text (ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bs)
  | Bool
otherwise = [Char] -> Doc
text [Char]
s
 where
  s :: [Char]
s = (Word8 -> Char) -> [Word8] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> [Char]) -> [Word8] -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
bs