module Test.QuickCheck.ContractModel.ThreatModel.Pretty where

import Cardano.Api
import Cardano.Api.Byron
import Cardano.Api.Shelley
import Cardano.Ledger.Alonzo.Tx qualified as Ledger (Data)
import Cardano.Ledger.Alonzo.TxWitness qualified as Ledger
import Cardano.Ledger.SafeHash qualified as Ledger

import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
import Data.ByteString qualified as BS
import Data.Char
import Data.List (nub, sort)
import Data.Map qualified as Map

import Test.QuickCheck.ContractModel.Internal.Common

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

import Test.QuickCheck.ContractModel.ThreatModel.TxModifier
import Test.QuickCheck.ContractModel.ThreatModel.Cardano.Api

-- | 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 :: [String] -> String
paragraph [String]
s = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ ([Doc] -> Doc
fsep ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> ([String] -> [String]) -> [String] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ [String]
s) Doc -> Doc -> Doc
$$ String -> Doc
text String
""

block :: Doc -> [Doc] -> Doc
block :: Doc -> [Doc] -> Doc
block 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
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

hblock' :: Int -> Doc -> [Doc] -> Doc
hblock' :: Int -> Doc -> [Doc] -> Doc
hblock' Int
n Doc
hd [Doc]
body = Doc
hd Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
n ([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
<> Doc
":") 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 (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
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 Doc
"UTxOs" [ Int -> Doc -> [Doc] -> Doc
hblock' Int
ind (TxIn -> Doc
prettyIn TxIn
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
":") [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
_) = -- TODO: ref script
  Doc -> [Doc] -> Doc
hblock Doc
"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'
                 ]
  where
    datum' :: Datum
datum' = case TxOutDatum CtxUTxO Era
datum of
      TxOutDatum CtxUTxO Era
TxOutDatumNone        -> Datum
forall ctx era. TxOutDatum ctx era
TxOutDatumNone
      TxOutDatumHash ScriptDataSupportedInEra Era
s Hash ScriptData
h    -> ScriptDataSupportedInEra Era -> Hash ScriptData -> Datum
forall era ctx.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatum ctx era
TxOutDatumHash ScriptDataSupportedInEra Era
s Hash ScriptData
h
      TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
s ScriptData
sd -> ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
-> ScriptData -> Datum
forall era ctx.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptData -> TxOutDatum ctx era
TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
s ScriptData
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
_) = -- TODO: ref script
  Doc -> [Doc] -> Doc
hblock Doc
"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
                 ]

prettyAddress :: AddressAny -> Doc
prettyAddress :: AddressAny -> Doc
prettyAddress (AddressByron (ByronAddress Address
a)) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Address -> String
forall a. Show a => a -> String
show Address
a
prettyAddress (AddressShelley (ShelleyAddress Network
_ PaymentCredential StandardCrypto
c StakeReference StandardCrypto
_)) =
  case PaymentCredential StandardCrypto -> PaymentCredential
fromShelleyPaymentCredential PaymentCredential StandardCrypto
c of
    PaymentCredentialByKey Hash PaymentKey
h    -> Doc
"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 -> Doc
"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) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show Word
txIx

prettyValue :: Value -> Doc
prettyValue :: Value -> Doc
prettyValue Value
value =
  [Doc] -> Doc
pSet [ AssetId -> Doc
prettyAssetId AssetId
assetId Doc -> Doc -> Doc
<:> String -> Doc
text (Quantity -> String
forall a. Show a => a -> String
show Quantity
num)
       | (AssetId
assetId, Quantity
num) <- Value -> [(AssetId, Quantity)]
valueToList Value
value ]

prettyAssetId :: AssetId -> Doc
prettyAssetId :: AssetId -> Doc
prettyAssetId AssetId
AdaAssetId = Doc
"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
<> Doc
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> AssetName -> Doc
prettyName AssetName
name
  where
    prettyName :: AssetName -> Doc
prettyName (AssetName ByteString
bs) = Bool -> ByteString -> Doc
prettyBytes Bool
False ByteString
bs

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

prettyDatum :: Datum -> Doc
prettyDatum :: Datum -> Doc
prettyDatum Datum
TxOutDatumNone         = Doc
empty
prettyDatum (TxOutDatumHash ScriptDataSupportedInEra Era
_ Hash ScriptData
h)   = Doc
"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 ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
_ ScriptData
d) = ScriptData -> Doc
prettyScriptData ScriptData
d
prettyDatum (TxOutDatumInTx ScriptDataSupportedInEra Era
_ ScriptData
d)   = ScriptData -> Doc
prettyScriptData ScriptData
d

prettyTx :: Tx Era -> Doc
prettyTx :: Tx Era -> Doc
prettyTx tx :: Tx Era
tx@(Tx body :: TxBody Era
body@(TxBody (TxBodyContent{TxIns ViewTx Era
[TxOut CtxTx Era]
(TxValidityLowerBound Era, TxValidityUpperBound Era)
BuildTxWith ViewTx (Maybe ProtocolParameters)
TxAuxScripts Era
TxCertificates ViewTx Era
TxExtraKeyWitnesses Era
TxFee Era
TxInsCollateral Era
TxInsReference ViewTx Era
TxMetadataInEra Era
TxMintValue ViewTx Era
TxReturnCollateral CtxTx Era
TxScriptValidity Era
TxTotalCollateral Era
TxUpdateProposal Era
TxWithdrawals ViewTx Era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txValidityRange :: forall build era.
TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txTotalCollateral :: forall build era. TxBodyContent build era -> TxTotalCollateral era
txScriptValidity :: forall build era. TxBodyContent build era -> TxScriptValidity era
txReturnCollateral :: forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txProtocolParams :: forall build era.
TxBodyContent build era
-> BuildTxWith build (Maybe ProtocolParameters)
txOuts :: forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txMintValue :: forall build era. TxBodyContent build era -> TxMintValue build era
txMetadata :: forall build era. TxBodyContent build era -> TxMetadataInEra era
txInsReference :: forall build era.
TxBodyContent build era -> TxInsReference build era
txInsCollateral :: forall build era. TxBodyContent build era -> TxInsCollateral era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txFee :: forall build era. TxBodyContent build era -> TxFee era
txExtraKeyWits :: forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txAuxScripts :: forall build era. TxBodyContent build era -> TxAuxScripts era
txScriptValidity :: TxScriptValidity Era
txMintValue :: TxMintValue ViewTx Era
txUpdateProposal :: TxUpdateProposal Era
txCertificates :: TxCertificates ViewTx Era
txWithdrawals :: TxWithdrawals ViewTx Era
txProtocolParams :: BuildTxWith ViewTx (Maybe ProtocolParameters)
txExtraKeyWits :: TxExtraKeyWitnesses Era
txAuxScripts :: TxAuxScripts Era
txMetadata :: TxMetadataInEra Era
txValidityRange :: (TxValidityLowerBound Era, TxValidityUpperBound Era)
txFee :: TxFee Era
txReturnCollateral :: TxReturnCollateral CtxTx Era
txTotalCollateral :: TxTotalCollateral Era
txOuts :: [TxOut CtxTx Era]
txInsReference :: TxInsReference ViewTx Era
txInsCollateral :: TxInsCollateral Era
txIns :: TxIns ViewTx Era
..})) [KeyWitness Era]
_) =
  Doc -> [Doc] -> Doc
block Doc
"Tx" [ Doc
"Valid:" Doc -> Doc -> Doc
<+> (TxValidityLowerBound Era, TxValidityUpperBound Era) -> Doc
prettyValidity (TxValidityLowerBound Era, TxValidityUpperBound Era)
txValidityRange
             , Doc -> [Doc] -> Doc
fblock Doc
"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
block Doc
"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 Doc
"Redeemers:" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((RdmrPtr, (Data StandardBabbage, ExUnits)) -> Doc)
-> [(RdmrPtr, (Data StandardBabbage, ExUnits))] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((RdmrPtr -> (Data StandardBabbage, ExUnits) -> Doc)
-> (RdmrPtr, (Data StandardBabbage, ExUnits)) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((RdmrPtr -> (Data StandardBabbage, ExUnits) -> Doc)
 -> (RdmrPtr, (Data StandardBabbage, ExUnits)) -> Doc)
-> (RdmrPtr -> (Data StandardBabbage, ExUnits) -> Doc)
-> (RdmrPtr, (Data StandardBabbage, ExUnits))
-> Doc
forall a b. (a -> b) -> a -> b
$ [TxIn]
-> [PolicyId] -> RdmrPtr -> (Data StandardBabbage, ExUnits) -> Doc
forall era.
[TxIn] -> [PolicyId] -> RdmrPtr -> (Data era, ExUnits) -> Doc
prettyRedeemer [TxIn]
inps [PolicyId]
mnts) ([(RdmrPtr, (Data StandardBabbage, ExUnits))] -> [Doc])
-> [(RdmrPtr, (Data StandardBabbage, ExUnits))] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Map RdmrPtr (Data StandardBabbage, ExUnits)
-> [(RdmrPtr, (Data StandardBabbage, ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList Map RdmrPtr (Data StandardBabbage, ExUnits)
rdmrs
             , Doc -> [Doc] -> Doc
block Doc
"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
    ShelleyTxBody ShelleyBasedEra Era
_ TxBody (ShelleyLedgerEra Era)
_ [Script (ShelleyLedgerEra Era)]
_ TxBodyScriptData Era
scriptdat Maybe (AuxiliaryData (ShelleyLedgerEra Era))
_ 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 MultiAssetSupportedInEra Era
_ Value
val BuildTxWith ViewTx (Map PolicyId (ScriptWitness WitCtxMint Era))
_ -> [ 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 -> [(AssetId, Quantity)]
valueToList Value
val ]
    rdmrs :: Map RdmrPtr (Data StandardBabbage, ExUnits)
rdmrs = case TxBodyScriptData Era
scriptdat of
              TxBodyScriptData ScriptDataSupportedInEra Era
_ TxDats (ShelleyLedgerEra Era)
_ (Ledger.Redeemers rdmrs) -> Map RdmrPtr (Data StandardBabbage, ExUnits)
rdmrs
              TxBodyScriptData Era
TxBodyNoScriptData                            -> Map RdmrPtr (Data StandardBabbage, ExUnits)
forall a. Monoid a => a
mempty

prettyRedeemer :: [TxIn] -> [PolicyId] -> Ledger.RdmrPtr -> (Ledger.Data era, Ledger.ExUnits) -> Doc
prettyRedeemer :: [TxIn] -> [PolicyId] -> RdmrPtr -> (Data era, ExUnits) -> Doc
prettyRedeemer [TxIn]
inps [PolicyId]
mints (Ledger.RdmrPtr Tag
tag Word64
ix) (Data era
dat, ExUnits
_) = Doc
pTag Doc -> Doc -> Doc
<:> ScriptData -> Doc
prettyScriptData (Data era -> ScriptData
forall ledgerera. Data ledgerera -> ScriptData
fromAlonzoData Data era
dat)
  where
    pTag :: Doc
pTag =
      case Tag
tag of
        Tag
Ledger.Spend -> Doc
"Spend" Doc -> Doc -> Doc
<+> TxIn -> Doc
prettyIn ([TxIn]
inps [TxIn] -> Int -> TxIn
forall a. [a] -> Int -> a
!! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ix)
        Tag
Ledger.Mint  -> Doc
"Mint" Doc -> Doc -> Doc
<+> PolicyId -> Doc
forall a. Show a => a -> Doc
prettyHash ([PolicyId]
mints [PolicyId] -> Int -> PolicyId
forall a. [a] -> Int -> a
!! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ix)
        Tag
_            -> String -> Doc
text (Tag -> String
forall a. Show a => a -> String
show Tag
tag)

prettyDatumMap :: TxBodyScriptData Era -> Doc
prettyDatumMap :: TxBodyScriptData Era -> Doc
prettyDatumMap (TxBodyScriptData ScriptDataSupportedInEra Era
_ (Ledger.TxDats dats) Redeemers (ShelleyLedgerEra Era)
_)
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map (DataHash StandardCrypto) (Data StandardBabbage) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map (DataHash StandardCrypto) (Data StandardBabbage)
Map (DataHash (Crypto StandardBabbage)) (Data StandardBabbage)
dats =
    Doc -> [Doc] -> Doc
block Doc
"Datums:"
      [ Hash Blake2b_256 EraIndependentData -> Doc
forall a. Show a => a -> Doc
prettyHash (DataHash StandardCrypto
-> Hash (HASH StandardCrypto) EraIndependentData
forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
Ledger.extractHash DataHash StandardCrypto
key) Doc -> Doc -> Doc
<:>
          ScriptData -> Doc
prettyScriptData (Data StandardBabbage -> ScriptData
forall ledgerera. Data ledgerera -> ScriptData
fromAlonzoData Data StandardBabbage
val)
      | (DataHash StandardCrypto
key, Data StandardBabbage
val) <- Map (DataHash StandardCrypto) (Data StandardBabbage)
-> [(DataHash StandardCrypto, Data StandardBabbage)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (DataHash StandardCrypto) (Data StandardBabbage)
Map (DataHash (Crypto StandardBabbage)) (Data StandardBabbage)
dats
      ]
prettyDatumMap TxBodyScriptData Era
_ = Doc
empty

prettyMinting :: TxMintValue build Era -> Doc
prettyMinting :: TxMintValue build Era -> Doc
prettyMinting TxMintValue build Era
TxMintNone            = Doc
empty
prettyMinting (TxMintValue MultiAssetSupportedInEra Era
_ Value
val BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint Era))
_) = Doc -> [Doc] -> Doc
block Doc
"Minting:" [Value -> Doc
prettyValue Value
val]

prettyValidity :: (TxValidityLowerBound Era, TxValidityUpperBound Era) -> Doc
prettyValidity :: (TxValidityLowerBound Era, TxValidityUpperBound Era) -> Doc
prettyValidity (TxValidityLowerBound Era
TxValidityNoLowerBound, TxValidityNoUpperBound{}) = Doc
"any"
prettyValidity (TxValidityLowerBound Era
lo, TxValidityUpperBound Era
hi) = TxValidityLowerBound Era -> Doc
prettyLowerBound TxValidityLowerBound Era
lo Doc -> Doc -> Doc
<+> Doc
"-" Doc -> Doc -> Doc
<+> TxValidityUpperBound Era -> Doc
prettyUpperBound TxValidityUpperBound Era
hi

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

prettyUpperBound :: TxValidityUpperBound Era -> Doc
prettyUpperBound :: TxValidityUpperBound Era -> Doc
prettyUpperBound TxValidityNoUpperBound{}      = Doc
"∞"
prettyUpperBound (TxValidityUpperBound ValidityUpperBoundSupportedInEra Era
_ SlotNo
slot) = String -> Doc
text (Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String) -> Word64 -> String
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
slot)

prettyTxModifier :: TxModifier -> Doc
prettyTxModifier :: TxModifier -> Doc
prettyTxModifier (TxModifier [TxMod]
txmod) = [Doc] -> Doc
vcat [TxMod -> Doc
prettyMod TxMod
mod | TxMod
mod <- [TxMod]
txmod]
  where
    prettyPlutusScript :: PlutusScript PlutusScriptV2 -> Doc
prettyPlutusScript = ScriptHash -> Doc
forall a. Show a => a -> Doc
prettyHash (ScriptHash -> Doc)
-> (PlutusScript PlutusScriptV2 -> ScriptHash)
-> PlutusScript PlutusScriptV2
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script PlutusScriptV2 -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script PlutusScriptV2 -> ScriptHash)
-> (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> PlutusScript PlutusScriptV2
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
    prettySimpleScript :: SimpleScript SimpleScriptV2 -> Doc
prettySimpleScript = ScriptHash -> Doc
forall a. Show a => a -> Doc
prettyHash (ScriptHash -> Doc)
-> (SimpleScript SimpleScriptV2 -> ScriptHash)
-> SimpleScript SimpleScriptV2
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script SimpleScriptV2 -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script SimpleScriptV2 -> ScriptHash)
-> (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> SimpleScript SimpleScriptV2
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2

    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) =
      Doc
"removeInput" Doc -> Doc -> Doc
<+> TxIn -> Doc
prettyIn TxIn
txIn

    prettyMod (RemoveOutput TxIx
ix) =
      Doc
"removeOutput" Doc -> Doc -> Doc
<+> TxIx -> Doc
prettyIx TxIx
ix

    prettyMod (ChangeOutput TxIx
ix Maybe AddressAny
maddr Maybe Value
mvalue Maybe Datum
mdatum) =
      [Doc] -> Doc
vcat [ Doc -> Doc -> (AddressAny -> Doc) -> Maybe AddressAny -> Doc
forall t. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock Doc
"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 Doc
"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 Doc
"changeDatumOf"   (TxIx -> Doc
prettyIx TxIx
ix) Datum -> Doc
prettyDatum Maybe Datum
mdatum
           ]

    prettyMod (ChangeInput TxIn
txIn Maybe AddressAny
maddr Maybe Value
mvalue Maybe Datum
mdatum) =
      [Doc] -> Doc
vcat [ Doc -> Doc -> (AddressAny -> Doc) -> Maybe AddressAny -> Doc
forall t. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock Doc
"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 Doc
"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 Doc
"changeDatumOf"   (TxIn -> Doc
prettyIn TxIn
txIn) Datum -> Doc
prettyDatum Maybe Datum
mdatum
           ]

    prettyMod (ChangeScriptInput TxIn
txIn Maybe Value
mvalue Maybe Datum
mdatum Maybe ScriptData
mrdmr) =
      [Doc] -> Doc
vcat [ Doc -> Doc -> (Value -> Doc) -> Maybe Value -> Doc
forall t. Doc -> Doc -> (t -> Doc) -> Maybe t -> Doc
maybeBlock Doc
"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 Doc
"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 Doc
"changeRedeemerOf" (TxIn -> Doc
prettyIn TxIn
txIn) ScriptData -> Doc
prettyScriptData Maybe ScriptData
mrdmr
           ]

    prettyMod (AddOutput AddressAny
addr Value
value Datum
datum) =
      Doc -> [Doc] -> Doc
fblock Doc
"addOutput" [ AddressAny -> Doc
prettyAddress AddressAny
addr
                         , Value -> Doc
prettyValue Value
value
                         , Datum -> Doc
prettyDatum Datum
datum
                         ]

    prettyMod (AddInput AddressAny
addr Value
value Datum
datum) =
      Doc -> [Doc] -> Doc
fblock Doc
"addInput" [ AddressAny -> Doc
prettyAddress AddressAny
addr
                        , Value -> Doc
prettyValue Value
value
                        , Datum -> Doc
prettyDatum Datum
datum
                        ]

    prettyMod (AddPlutusScriptInput PlutusScript PlutusScriptV2
script Value
value Datum
datum ScriptData
redeemer) =
      Doc -> [Doc] -> Doc
fblock Doc
"addPlutusScriptInput" [ PlutusScript PlutusScriptV2 -> Doc
prettyPlutusScript PlutusScript PlutusScriptV2
script
                                    , Value -> Doc
prettyValue Value
value
                                    , Datum -> Doc
prettyDatum Datum
datum
                                    , ScriptData -> Doc
prettyScriptData ScriptData
redeemer
                                    ]

    prettyMod (AddSimpleScriptInput SimpleScript SimpleScriptV2
script Value
value) =
      Doc -> [Doc] -> Doc
fblock Doc
"addSimpleScriptInput" [ SimpleScript SimpleScriptV2 -> Doc
prettySimpleScript SimpleScript SimpleScriptV2
script
                                    , Value -> Doc
prettyValue Value
value
                                    ]

    prettyMod (ChangeValidityRange (Just TxValidityLowerBound Era
lo) (Just TxValidityUpperBound Era
hi)) =
      Doc -> [Doc] -> Doc
fblock Doc
"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 Doc
"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 Doc
"changeValidityUpperBound" Doc
empty TxValidityUpperBound Era -> Doc
prettyUpperBound Maybe (TxValidityUpperBound Era)
mhi
           ]

    prettyMod (ReplaceTx Tx Era
tx UTxO Era
utxos) =
      Doc -> [Doc] -> Doc
fblock Doc
"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) = Doc
"Con" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Integer -> String
forall a. Show a => a -> String
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) = String -> Doc
text (Integer -> String
forall a. Show a => a -> String
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
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPrint) String
s = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
7 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02x") ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
forall a. Enum a => a -> Int
fromEnum String
s
  | Bool
quotes                = String -> Doc
text (ByteString -> String
forall a. Show a => a -> String
show ByteString
bs)
  | Bool
otherwise             = String -> Doc
text String
s
  where
    s :: String
s = (Word8 -> Char) -> [Word8] -> String
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] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
bs