{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | User-friendly pretty-printing for textual user interfaces (TUI)
module Cardano.CLI.Run.Friendly (friendlyTxBS, friendlyTxBodyBS) where

import           Data.Aeson (Value (..), object, toJSON, (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Aeson
import qualified Data.Aeson.Types as Aeson
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BSC
import           Data.Char (isAscii)
import           Data.Function ((&))
import           Data.Functor ((<&>))
import qualified Data.Map.Strict as Map
import           Data.Maybe (catMaybes, isJust)
import           Data.Ratio (numerator)
import qualified Data.Text as Text
import           Data.Yaml (array)
import           Data.Yaml.Pretty (setConfCompare)
import qualified Data.Yaml.Pretty as Yaml
import           GHC.Real (denominator)
import           GHC.Unicode (isAlphaNum)

import           Cardano.Api as Api
import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness))
import           Cardano.Api.Shelley (Address (ShelleyAddress),
                   KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..),
                   StakeCredential (..), StakePoolParameters (..), fromShelleyPaymentCredential,
                   fromShelleyStakeCredential, fromShelleyStakeReference)
import qualified Cardano.Ledger.Shelley.API as Shelley

yamlConfig :: Yaml.Config
yamlConfig :: Config
yamlConfig = Config
Yaml.defConfig forall a b. a -> (a -> b) -> b
& (Text -> Text -> Ordering) -> Config -> Config
setConfCompare forall a. Ord a => a -> a -> Ordering
compare

friendlyTxBS :: IsCardanoEra era => CardanoEra era -> Tx era -> ByteString
friendlyTxBS :: forall era.
IsCardanoEra era =>
CardanoEra era -> Tx era -> ByteString
friendlyTxBS CardanoEra era
era = forall a. ToJSON a => Config -> a -> ByteString
Yaml.encodePretty Config
yamlConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. IsCardanoEra era => CardanoEra era -> Tx era -> [Pair]
friendlyTx CardanoEra era
era

friendlyTx :: IsCardanoEra era => CardanoEra era -> Tx era -> [Aeson.Pair]
friendlyTx :: forall era. IsCardanoEra era => CardanoEra era -> Tx era -> [Pair]
friendlyTx CardanoEra era
era (Tx TxBody era
body [KeyWitness era]
witnesses) =
  (Key
"witnesses" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall era. KeyWitness era -> Value
friendlyKeyWitness [KeyWitness era]
witnesses) forall a. a -> [a] -> [a]
: forall era.
IsCardanoEra era =>
CardanoEra era -> TxBody era -> [Pair]
friendlyTxBody CardanoEra era
era TxBody era
body

friendlyKeyWitness :: KeyWitness era -> Aeson.Value
friendlyKeyWitness :: forall era. KeyWitness era -> Value
friendlyKeyWitness =
  [Pair] -> Value
object
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ByronKeyWitness TxInWitness
txInWitness -> [Key
"Byron witness" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> Text
textShow TxInWitness
txInWitness]
      ShelleyBootstrapWitness ShelleyBasedEra era
_era BootstrapWitness StandardCrypto
bootstrapWitness ->
        [Key
"bootstrap witness" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> Text
textShow BootstrapWitness StandardCrypto
bootstrapWitness]
      ShelleyKeyWitness ShelleyBasedEra era
_era (Shelley.WitVKey VKey 'Witness StandardCrypto
key SignedDSIGN
  StandardCrypto (Hash StandardCrypto EraIndependentTxBody)
signature) ->
        [Key
"key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> Text
textShow VKey 'Witness StandardCrypto
key, Key
"signature" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> Text
textShow SignedDSIGN
  StandardCrypto (Hash StandardCrypto EraIndependentTxBody)
signature]

friendlyTxBodyBS
  :: IsCardanoEra era => CardanoEra era -> TxBody era -> ByteString
friendlyTxBodyBS :: forall era.
IsCardanoEra era =>
CardanoEra era -> TxBody era -> ByteString
friendlyTxBodyBS CardanoEra era
era =
  forall a. ToJSON a => Config -> a -> ByteString
Yaml.encodePretty Config
yamlConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
IsCardanoEra era =>
CardanoEra era -> TxBody era -> [Pair]
friendlyTxBody CardanoEra era
era

friendlyTxBody
  :: IsCardanoEra era => CardanoEra era -> TxBody era -> [Aeson.Pair]
friendlyTxBody :: forall era.
IsCardanoEra era =>
CardanoEra era -> TxBody era -> [Pair]
friendlyTxBody
  CardanoEra era
era
  (TxBody
    TxBodyContent
      { TxAuxScripts era
txAuxScripts :: forall build era. TxBodyContent build era -> TxAuxScripts era
txAuxScripts :: TxAuxScripts era
txAuxScripts
      , TxCertificates ViewTx era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates :: TxCertificates ViewTx era
txCertificates
      , TxExtraKeyWitnesses era
txExtraKeyWits :: forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txExtraKeyWits :: TxExtraKeyWitnesses era
txExtraKeyWits
      , TxFee era
txFee :: forall build era. TxBodyContent build era -> TxFee era
txFee :: TxFee era
txFee
      , TxIns ViewTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns :: TxIns ViewTx era
txIns
      , TxInsCollateral era
txInsCollateral :: forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral :: TxInsCollateral era
txInsCollateral
      , TxMetadataInEra era
txMetadata :: forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata :: TxMetadataInEra era
txMetadata
      , TxMintValue ViewTx era
txMintValue :: forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue :: TxMintValue ViewTx era
txMintValue
      , [TxOut CtxTx era]
txOuts :: forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts :: [TxOut CtxTx era]
txOuts
      , TxTotalCollateral era
txTotalCollateral :: forall build era. TxBodyContent build era -> TxTotalCollateral era
txTotalCollateral :: TxTotalCollateral era
txTotalCollateral
      , TxReturnCollateral CtxTx era
txReturnCollateral :: forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txReturnCollateral :: TxReturnCollateral CtxTx era
txReturnCollateral
      , TxInsReference ViewTx era
txInsReference :: forall build era.
TxBodyContent build era -> TxInsReference build era
txInsReference :: TxInsReference ViewTx era
txInsReference
      , TxUpdateProposal era
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txUpdateProposal :: TxUpdateProposal era
txUpdateProposal
      , (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange :: forall build era.
TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange :: (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange
      , TxWithdrawals ViewTx era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals :: TxWithdrawals ViewTx era
txWithdrawals
      }) =
    [ Key
"auxiliary scripts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxAuxScripts era -> Value
friendlyAuxScripts TxAuxScripts era
txAuxScripts
    , Key
"certificates" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxCertificates ViewTx era -> Value
friendlyCertificates TxCertificates ViewTx era
txCertificates
    , Key
"collateral inputs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxInsCollateral era -> Value
friendlyCollateralInputs TxInsCollateral era
txInsCollateral
    , Key
"era" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CardanoEra era
era
    , Key
"fee" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxFee era -> Value
friendlyFee TxFee era
txFee
    , Key
"inputs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall build. [(TxIn, build)] -> Value
friendlyInputs TxIns ViewTx era
txIns
    , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxMetadataInEra era -> Value
friendlyMetadata TxMetadataInEra era
txMetadata
    , Key
"mint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxMintValue ViewTx era -> Value
friendlyMintValue TxMintValue ViewTx era
txMintValue
    , Key
"outputs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall era. IsCardanoEra era => TxOut CtxTx era -> Value
friendlyTxOut [TxOut CtxTx era]
txOuts
    , Key
"reference inputs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall build era. TxInsReference build era -> Value
friendlyReferenceInputs TxInsReference ViewTx era
txInsReference
    , Key
"total collateral" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxTotalCollateral era -> Value
friendlyTotalCollateral TxTotalCollateral era
txTotalCollateral
    , Key
"return collateral" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era.
IsCardanoEra era =>
TxReturnCollateral CtxTx era -> Value
friendlyReturnCollateral TxReturnCollateral CtxTx era
txReturnCollateral
    , Key
"required signers (payment key hashes needed for scripts)" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
        forall era. TxExtraKeyWitnesses era -> Value
friendlyExtraKeyWits TxExtraKeyWitnesses era
txExtraKeyWits
    , Key
"update proposal" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxUpdateProposal era -> Value
friendlyUpdateProposal TxUpdateProposal era
txUpdateProposal
    , Key
"validity range" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era.
CardanoEra era
-> (TxValidityLowerBound era, TxValidityUpperBound era) -> Value
friendlyValidityRange CardanoEra era
era (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange
    , Key
"withdrawals" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxWithdrawals ViewTx era -> Value
friendlyWithdrawals TxWithdrawals ViewTx era
txWithdrawals
    ]

friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value
friendlyTotalCollateral :: forall era. TxTotalCollateral era -> Value
friendlyTotalCollateral TxTotalCollateral era
TxTotalCollateralNone = Value
Aeson.Null
friendlyTotalCollateral (TxTotalCollateral TxTotalAndReturnCollateralSupportedInEra era
_ Lovelace
coll) = forall a. ToJSON a => a -> Value
toJSON Lovelace
coll

friendlyReturnCollateral
  :: IsCardanoEra era => TxReturnCollateral CtxTx era -> Aeson.Value
friendlyReturnCollateral :: forall era.
IsCardanoEra era =>
TxReturnCollateral CtxTx era -> Value
friendlyReturnCollateral TxReturnCollateral CtxTx era
TxReturnCollateralNone = Value
Aeson.Null
friendlyReturnCollateral (TxReturnCollateral TxTotalAndReturnCollateralSupportedInEra era
_ TxOut CtxTx era
collOut) = forall era. IsCardanoEra era => TxOut CtxTx era -> Value
friendlyTxOut TxOut CtxTx era
collOut

friendlyExtraKeyWits :: TxExtraKeyWitnesses era -> Aeson.Value
friendlyExtraKeyWits :: forall era. TxExtraKeyWitnesses era -> Value
friendlyExtraKeyWits = \case
  TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone -> Value
Null
  TxExtraKeyWitnesses TxExtraKeyWitnessesSupportedInEra era
_supported [Hash PaymentKey]
paymentKeyHashes ->
    forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText [Hash PaymentKey]
paymentKeyHashes

-- | Special case of validity range:
-- in Shelley, upper bound is TTL, and no lower bound
pattern ShelleyTtl
  :: SlotNo -> (TxValidityLowerBound era, TxValidityUpperBound era)
pattern $mShelleyTtl :: forall {r} {era}.
(TxValidityLowerBound era, TxValidityUpperBound era)
-> (SlotNo -> r) -> ((# #) -> r) -> r
ShelleyTtl ttl <-
  ( TxValidityNoLowerBound
  , TxValidityUpperBound ValidityUpperBoundInShelleyEra ttl
  )

friendlyValidityRange
  :: CardanoEra era
  -> (TxValidityLowerBound era, TxValidityUpperBound era)
  -> Aeson.Value
friendlyValidityRange :: forall era.
CardanoEra era
-> (TxValidityLowerBound era, TxValidityUpperBound era) -> Value
friendlyValidityRange CardanoEra era
era = \case
  ShelleyTtl SlotNo
ttl -> [Pair] -> Value
object [Key
"time to live" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
ttl]
  (TxValidityLowerBound era
lowerBound, TxValidityUpperBound era
upperBound)
    | Bool
isLowerBoundSupported Bool -> Bool -> Bool
|| Bool
isUpperBoundSupported ->
        [Pair] -> Value
object
          [ Key
"lower bound" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                case TxValidityLowerBound era
lowerBound of
                  TxValidityLowerBound era
TxValidityNoLowerBound -> Value
Null
                  TxValidityLowerBound ValidityLowerBoundSupportedInEra era
_ SlotNo
s -> forall a. ToJSON a => a -> Value
toJSON SlotNo
s
          , Key
"upper bound" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
              case TxValidityUpperBound era
upperBound of
                TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra era
_ -> Value
Null
                TxValidityUpperBound ValidityUpperBoundSupportedInEra era
_ SlotNo
s -> forall a. ToJSON a => a -> Value
toJSON SlotNo
s
          ]
    | Bool
otherwise -> Value
Null
 where
  isLowerBoundSupported :: Bool
isLowerBoundSupported = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
validityLowerBoundSupportedInEra CardanoEra era
era
  isUpperBoundSupported :: Bool
isUpperBoundSupported = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall era.
CardanoEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
validityUpperBoundSupportedInEra CardanoEra era
era

friendlyWithdrawals :: TxWithdrawals ViewTx era -> Aeson.Value
friendlyWithdrawals :: forall era. TxWithdrawals ViewTx era -> Value
friendlyWithdrawals TxWithdrawals ViewTx era
TxWithdrawalsNone = Value
Null
friendlyWithdrawals (TxWithdrawals WithdrawalsSupportedInEra era
_ [(StakeAddress, Lovelace,
  BuildTxWith ViewTx (Witness WitCtxStake era))]
withdrawals) =
  [Value] -> Value
array
    [ [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
        Key
"address" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress StakeAddress
addr forall a. a -> [a] -> [a]
:
        Key
"amount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
amount forall a. a -> [a] -> [a]
:
        StakeAddress -> [Pair]
friendlyStakeAddress StakeAddress
addr
    | (StakeAddress
addr, Lovelace
amount, BuildTxWith ViewTx (Witness WitCtxStake era)
_) <- [(StakeAddress, Lovelace,
  BuildTxWith ViewTx (Witness WitCtxStake era))]
withdrawals
    ]

friendlyStakeAddress :: StakeAddress -> [Aeson.Pair]
friendlyStakeAddress :: StakeAddress -> [Pair]
friendlyStakeAddress (StakeAddress Network
net StakeCredential StandardCrypto
cred) =
  [ Key
"network" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Network
net
  , StakeCredential -> Pair
friendlyStakeCredential forall a b. (a -> b) -> a -> b
$ StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential StakeCredential StandardCrypto
cred
  ]

friendlyTxOut :: IsCardanoEra era => TxOut CtxTx era -> Aeson.Value
friendlyTxOut :: forall era. IsCardanoEra era => TxOut CtxTx era -> Value
friendlyTxOut (TxOut AddressInEra era
addr TxOutValue era
amount TxOutDatum CtxTx era
mdatum ReferenceScript era
script) =
  [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
    case AddressInEra era
addr of
      AddressInEra AddressTypeInEra addrtype era
ByronAddressInAnyEra Address addrtype
byronAdr ->
        [ Key
"address era" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Byron"
        , Key
"address" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address addrtype
byronAdr
        , Key
"amount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxOutValue era -> Value
friendlyTxOutValue TxOutValue era
amount
        ]
      AddressInEra (ShelleyAddressInEra ShelleyBasedEra era
sbe) saddr :: Address addrtype
saddr@(ShelleyAddress Network
net PaymentCredential StandardCrypto
cred StakeReference StandardCrypto
stake) ->
        let preAlonzo :: [Pair]
preAlonzo =
              PaymentCredential -> Pair
friendlyPaymentCredential (PaymentCredential StandardCrypto -> PaymentCredential
fromShelleyPaymentCredential PaymentCredential StandardCrypto
cred) forall a. a -> [a] -> [a]
:
              [ Key
"address era" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"Shelley"
              , Key
"network" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Network
net
              , Key
"address" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address addrtype
saddr
              , Key
"amount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxOutValue era -> Value
friendlyTxOutValue TxOutValue era
amount
              , Key
"stake reference" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                  StakeAddressReference -> Value
friendlyStakeReference (StakeReference StandardCrypto -> StakeAddressReference
fromShelleyStakeReference StakeReference StandardCrypto
stake)
              ]
            datum :: [Pair]
datum =
              [ Key
"datum" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall era. TxOutDatum CtxTx era -> Value
renderDatum TxOutDatum CtxTx era
mdatum
              | forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall era. CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra forall a b. (a -> b) -> a -> b
$ forall era. ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra ShelleyBasedEra era
sbe
              ]
            sinceAlonzo :: [Pair]
sinceAlonzo = [Key
"reference script" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ReferenceScript era
script]
        in [Pair]
preAlonzo forall a. [a] -> [a] -> [a]
++ [Pair]
datum forall a. [a] -> [a] -> [a]
++ [Pair]
sinceAlonzo
 where
  renderDatum :: TxOutDatum CtxTx era -> Aeson.Value
  renderDatum :: forall era. TxOutDatum CtxTx era -> Value
renderDatum TxOutDatum CtxTx era
TxOutDatumNone = Value
Aeson.Null
  renderDatum (TxOutDatumHash ScriptDataSupportedInEra era
_ Hash ScriptData
h) =
    Text -> Value
Aeson.String forall a b. (a -> b) -> a -> b
$ forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash ScriptData
h
  renderDatum (TxOutDatumInTx ScriptDataSupportedInEra era
_ HashableScriptData
sData) =
    ScriptDataJsonSchema -> HashableScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema HashableScriptData
sData
  renderDatum (TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ HashableScriptData
sData) =
    ScriptDataJsonSchema -> HashableScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema HashableScriptData
sData


friendlyStakeReference :: StakeAddressReference -> Aeson.Value
friendlyStakeReference :: StakeAddressReference -> Value
friendlyStakeReference = \case
  StakeAddressReference
NoStakeAddress -> Value
Null
  StakeAddressByPointer StakeAddressPointer
ptr -> Text -> Value
String (forall a. Show a => a -> Text
textShow StakeAddressPointer
ptr)
  StakeAddressByValue StakeCredential
cred -> [Pair] -> Value
object [StakeCredential -> Pair
friendlyStakeCredential StakeCredential
cred]

friendlyUpdateProposal :: TxUpdateProposal era -> Aeson.Value
friendlyUpdateProposal :: forall era. TxUpdateProposal era -> Value
friendlyUpdateProposal = \case
  TxUpdateProposal era
TxUpdateProposalNone -> Value
Null
  TxUpdateProposal UpdateProposalSupportedInEra era
_ (UpdateProposal Map (Hash GenesisKey) ProtocolParametersUpdate
parameterUpdates EpochNo
epoch) ->
    [Pair] -> Value
object
      [ Key
"epoch" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= EpochNo
epoch
      , Key
"updates" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
        [ [Pair] -> Value
object
            [ Key
"genesis key hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash GenesisKey
genesisKeyHash
            , Key
"update" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ProtocolParametersUpdate -> Value
friendlyProtocolParametersUpdate ProtocolParametersUpdate
parameterUpdate
            ]
        | (Hash GenesisKey
genesisKeyHash, ProtocolParametersUpdate
parameterUpdate) <- forall k a. Map k a -> [(k, a)]
Map.assocs Map (Hash GenesisKey) ProtocolParametersUpdate
parameterUpdates
        ]
      ]

friendlyProtocolParametersUpdate :: ProtocolParametersUpdate -> Aeson.Value
friendlyProtocolParametersUpdate :: ProtocolParametersUpdate -> Value
friendlyProtocolParametersUpdate
  ProtocolParametersUpdate
    { Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: ProtocolParametersUpdate -> Maybe (Natural, Natural)
protocolUpdateProtocolVersion :: Maybe (Natural, Natural)
protocolUpdateProtocolVersion
    , Maybe Rational
protocolUpdateDecentralization :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateDecentralization :: Maybe Rational
protocolUpdateDecentralization
    , Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: ProtocolParametersUpdate -> Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy
    , Maybe Natural
protocolUpdateMaxBlockHeaderSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockHeaderSize :: Maybe Natural
protocolUpdateMaxBlockHeaderSize
    , Maybe Natural
protocolUpdateMaxBlockBodySize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxBlockBodySize :: Maybe Natural
protocolUpdateMaxBlockBodySize
    , Maybe Natural
protocolUpdateMaxTxSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxTxSize :: Maybe Natural
protocolUpdateMaxTxSize
    , Maybe Natural
protocolUpdateTxFeeFixed :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeeFixed :: Maybe Natural
protocolUpdateTxFeeFixed
    , Maybe Natural
protocolUpdateTxFeePerByte :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateTxFeePerByte :: Maybe Natural
protocolUpdateTxFeePerByte
    , Maybe Lovelace
protocolUpdateMinUTxOValue :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinUTxOValue :: Maybe Lovelace
protocolUpdateMinUTxOValue
    , Maybe Lovelace
protocolUpdateStakeAddressDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakeAddressDeposit :: Maybe Lovelace
protocolUpdateStakeAddressDeposit
    , Maybe Lovelace
protocolUpdateStakePoolDeposit :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateStakePoolDeposit :: Maybe Lovelace
protocolUpdateStakePoolDeposit
    , Maybe Lovelace
protocolUpdateMinPoolCost :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateMinPoolCost :: Maybe Lovelace
protocolUpdateMinPoolCost
    , Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: ProtocolParametersUpdate -> Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch :: Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch
    , Maybe Natural
protocolUpdateStakePoolTargetNum :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateStakePoolTargetNum :: Maybe Natural
protocolUpdateStakePoolTargetNum
    , Maybe Rational
protocolUpdatePoolPledgeInfluence :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdatePoolPledgeInfluence :: Maybe Rational
protocolUpdatePoolPledgeInfluence
    , Maybe Rational
protocolUpdateMonetaryExpansion :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateMonetaryExpansion :: Maybe Rational
protocolUpdateMonetaryExpansion
    , Maybe Rational
protocolUpdateTreasuryCut :: ProtocolParametersUpdate -> Maybe Rational
protocolUpdateTreasuryCut :: Maybe Rational
protocolUpdateTreasuryCut
    , Maybe Lovelace
protocolUpdateUTxOCostPerWord :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateUTxOCostPerWord :: Maybe Lovelace
protocolUpdateUTxOCostPerWord
    , Maybe Natural
protocolUpdateCollateralPercent :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateCollateralPercent :: Maybe Natural
protocolUpdateCollateralPercent
    , Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits :: Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits
    , Maybe Natural
protocolUpdateMaxCollateralInputs :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxCollateralInputs :: Maybe Natural
protocolUpdateMaxCollateralInputs
    , Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: ProtocolParametersUpdate -> Maybe ExecutionUnits
protocolUpdateMaxTxExUnits :: Maybe ExecutionUnits
protocolUpdateMaxTxExUnits
    , Maybe Natural
protocolUpdateMaxValueSize :: ProtocolParametersUpdate -> Maybe Natural
protocolUpdateMaxValueSize :: Maybe Natural
protocolUpdateMaxValueSize
    , Maybe ExecutionUnitPrices
protocolUpdatePrices :: ProtocolParametersUpdate -> Maybe ExecutionUnitPrices
protocolUpdatePrices :: Maybe ExecutionUnitPrices
protocolUpdatePrices
    , Maybe Lovelace
protocolUpdateUTxOCostPerByte :: ProtocolParametersUpdate -> Maybe Lovelace
protocolUpdateUTxOCostPerByte :: Maybe Lovelace
protocolUpdateUTxOCostPerByte
    } =
  [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
    [ Maybe (Natural, Natural)
protocolUpdateProtocolVersion forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Natural
major, Natural
minor) ->
        Key
"protocol version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall a. Show a => a -> Text
textShow Natural
major forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow Natural
minor)
    , Maybe Rational
protocolUpdateDecentralization forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"decentralization parameter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Value
friendlyRational
    , Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"extra entropy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
"reset" forall a. ToJSON a => a -> Value
toJSON
    , Maybe Natural
protocolUpdateMaxBlockHeaderSize forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max block header size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Natural
protocolUpdateMaxBlockBodySizeforall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max block body size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Natural
protocolUpdateMaxTxSize forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max transaction size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Natural
protocolUpdateTxFeeFixed forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"transaction fee constant" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Natural
protocolUpdateTxFeePerByte forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"transaction fee linear per byte" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Lovelace
protocolUpdateMinUTxOValue forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"min UTxO value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Value
friendlyLovelace
    , Maybe Lovelace
protocolUpdateStakeAddressDeposit forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"key registration deposit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Value
friendlyLovelace
    , Maybe Lovelace
protocolUpdateStakePoolDeposit forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"pool registration deposit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Value
friendlyLovelace
    , Maybe Lovelace
protocolUpdateMinPoolCost forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"min pool cost" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Value
friendlyLovelace
    , Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"pool retirement epoch boundary" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Natural
protocolUpdateStakePoolTargetNum forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"number of pools" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Rational
protocolUpdatePoolPledgeInfluence forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"pool influence" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Value
friendlyRational
    , Maybe Rational
protocolUpdateMonetaryExpansion forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"monetary expansion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Value
friendlyRational
    , Maybe Rational
protocolUpdateTreasuryCut forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"treasury expansion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Value
friendlyRational
    , Maybe Lovelace
protocolUpdateUTxOCostPerWord forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"UTxO storage cost per word" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Value
friendlyLovelace
    , Maybe Natural
protocolUpdateCollateralPercent forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"collateral inputs share" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
"%") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
textShow
    , Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max block execution units" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Natural
protocolUpdateMaxCollateralInputs forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max collateral inputs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe ExecutionUnits
protocolUpdateMaxTxExUnits forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max transaction execution units" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe Natural
protocolUpdateMaxValueSize forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max value size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
    , Maybe ExecutionUnitPrices
protocolUpdatePrices forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"execution prices" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutionUnitPrices -> Value
friendlyPrices
    , Maybe Lovelace
protocolUpdateUTxOCostPerByte forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        (Key
"UTxO storage cost per byte" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Value
friendlyLovelace
    ]

friendlyPrices :: ExecutionUnitPrices -> Aeson.Value
friendlyPrices :: ExecutionUnitPrices -> Value
friendlyPrices ExecutionUnitPrices{Rational
priceExecutionMemory :: ExecutionUnitPrices -> Rational
priceExecutionMemory :: Rational
priceExecutionMemory, Rational
priceExecutionSteps :: ExecutionUnitPrices -> Rational
priceExecutionSteps :: Rational
priceExecutionSteps} =
  [Pair] -> Value
object
    [ Key
"memory" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
friendlyRational Rational
priceExecutionMemory
    , Key
"steps" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
friendlyRational Rational
priceExecutionSteps
    ]

friendlyCertificates :: TxCertificates ViewTx era -> Aeson.Value
friendlyCertificates :: forall era. TxCertificates ViewTx era -> Value
friendlyCertificates = \case
  TxCertificates ViewTx era
TxCertificatesNone -> Value
Null
  TxCertificates CertificatesSupportedInEra era
_ [Certificate]
cs BuildTxWith ViewTx (Map StakeCredential (Witness WitCtxStake era))
_ -> [Value] -> Value
array forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Certificate -> Value
friendlyCertificate [Certificate]
cs

friendlyCertificate :: Certificate -> Aeson.Value
friendlyCertificate :: Certificate -> Value
friendlyCertificate =
  [Pair] -> Value
object
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: [])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      -- Stake address certificates
      StakeAddressRegistrationCertificate StakeCredential
credential ->
        Key
"stake address registration"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [StakeCredential -> Pair
friendlyStakeCredential StakeCredential
credential]
      StakeAddressDeregistrationCertificate StakeCredential
credential ->
        Key
"stake address deregistration"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [StakeCredential -> Pair
friendlyStakeCredential StakeCredential
credential]
      StakeAddressDelegationCertificate StakeCredential
credential PoolId
poolId ->
        Key
"stake address delegation"
          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [StakeCredential -> Pair
friendlyStakeCredential StakeCredential
credential, Key
"pool" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolId
poolId]

      -- Stake pool certificates
      StakePoolRegistrationCertificate StakePoolParameters
parameters ->
        Key
"stake pool registration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StakePoolParameters -> Value
friendlyStakePoolParameters StakePoolParameters
parameters
      StakePoolRetirementCertificate PoolId
poolId EpochNo
epochNo ->
        Key
"stake pool retirement" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"pool" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolId
poolId, Key
"epoch" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= EpochNo
epochNo]

      -- Special certificates
      GenesisKeyDelegationCertificate
        Hash GenesisKey
genesisKeyHash
        Hash GenesisDelegateKey
delegateKeyHash
        Hash VrfKey
vrfKeyHash ->
          Key
"genesis key delegation"
            forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
              [ Key
"genesis key hash"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash GenesisKey
genesisKeyHash,
                Key
"delegate key hash"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash GenesisDelegateKey
delegateKeyHash,
                Key
"VRF key hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash VrfKey
vrfKeyHash
              ]
      MIRCertificate MIRPot
pot MIRTarget
target ->
        Key
"MIR" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"pot" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MIRPot -> Value
friendlyMirPot MIRPot
pot, MIRTarget -> Pair
friendlyMirTarget MIRTarget
target]

friendlyMirTarget :: MIRTarget -> Aeson.Pair
friendlyMirTarget :: MIRTarget -> Pair
friendlyMirTarget = \case
  StakeAddressesMIR [(StakeCredential, Lovelace)]
addresses ->
    Key
"target stake addresses" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
      [ [Pair] -> Value
object
          [ StakeCredential -> Pair
friendlyStakeCredential StakeCredential
credential
          , Key
"amount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
lovelace
          ]
      | (StakeCredential
credential, Lovelace
lovelace) <- [(StakeCredential, Lovelace)]
addresses
      ]
  SendToReservesMIR Lovelace
amount -> Key
"send to reserves" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
amount
  SendToTreasuryMIR Lovelace
amount -> Key
"send to treasury" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
amount

friendlyStakeCredential :: StakeCredential -> Aeson.Pair
friendlyStakeCredential :: StakeCredential -> Pair
friendlyStakeCredential = \case
  StakeCredentialByKey Hash StakeKey
keyHash ->
    Key
"stake credential key hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash StakeKey
keyHash
  StakeCredentialByScript ScriptHash
scriptHash ->
    Key
"stake credential script hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText ScriptHash
scriptHash

friendlyPaymentCredential :: PaymentCredential -> Aeson.Pair
friendlyPaymentCredential :: PaymentCredential -> Pair
friendlyPaymentCredential = \case
  PaymentCredentialByKey Hash PaymentKey
keyHash ->
    Key
"payment credential key hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash PaymentKey
keyHash
  PaymentCredentialByScript ScriptHash
scriptHash ->
    Key
"payment credential script hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText ScriptHash
scriptHash

friendlyMirPot :: Shelley.MIRPot -> Aeson.Value
friendlyMirPot :: MIRPot -> Value
friendlyMirPot = \case
  MIRPot
Shelley.ReservesMIR -> Value
"reserves"
  MIRPot
Shelley.TreasuryMIR -> Value
"treasury"

friendlyStakePoolParameters :: StakePoolParameters -> Aeson.Value
friendlyStakePoolParameters :: StakePoolParameters -> Value
friendlyStakePoolParameters
  StakePoolParameters
    { PoolId
stakePoolId :: StakePoolParameters -> PoolId
stakePoolId :: PoolId
stakePoolId
    , Hash VrfKey
stakePoolVRF :: StakePoolParameters -> Hash VrfKey
stakePoolVRF :: Hash VrfKey
stakePoolVRF
    , Lovelace
stakePoolCost :: StakePoolParameters -> Lovelace
stakePoolCost :: Lovelace
stakePoolCost
    , Rational
stakePoolMargin :: StakePoolParameters -> Rational
stakePoolMargin :: Rational
stakePoolMargin
    , StakeAddress
stakePoolRewardAccount :: StakePoolParameters -> StakeAddress
stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount
    , Lovelace
stakePoolPledge :: StakePoolParameters -> Lovelace
stakePoolPledge :: Lovelace
stakePoolPledge
    , [Hash StakeKey]
stakePoolOwners :: StakePoolParameters -> [Hash StakeKey]
stakePoolOwners :: [Hash StakeKey]
stakePoolOwners
    , [StakePoolRelay]
stakePoolRelays :: StakePoolParameters -> [StakePoolRelay]
stakePoolRelays :: [StakePoolRelay]
stakePoolRelays
    , Maybe StakePoolMetadataReference
stakePoolMetadata :: StakePoolParameters -> Maybe StakePoolMetadataReference
stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata
    } =
  [Pair] -> Value
object
    [ Key
"pool" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolId
stakePoolId
    , Key
"VRF key hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash VrfKey
stakePoolVRF
    , Key
"cost" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
stakePoolCost
    , Key
"margin" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
friendlyRational Rational
stakePoolMargin
    , Key
"reward account" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object (StakeAddress -> [Pair]
friendlyStakeAddress StakeAddress
stakePoolRewardAccount)
    , Key
"pledge" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
stakePoolPledge
    , Key
"owners (stake key hashes)"
        forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText [Hash StakeKey]
stakePoolOwners
    , Key
"relays" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
textShow [StakePoolRelay]
stakePoolRelays
    , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> Text
textShow Maybe StakePoolMetadataReference
stakePoolMetadata
    ]

friendlyRational :: Rational -> Aeson.Value
friendlyRational :: Rational -> Value
friendlyRational Rational
r =
  Text -> Value
String forall a b. (a -> b) -> a -> b
$
    case Integer
d of
      Integer
1 -> forall a. Show a => a -> Text
textShow Integer
n
      Integer
_ -> forall a. Show a => a -> Text
textShow Integer
n forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow Integer
d
 where
  n :: Integer
n = forall a. Ratio a -> a
numerator Rational
r
  d :: Integer
d = forall a. Ratio a -> a
denominator Rational
r

friendlyFee :: TxFee era -> Aeson.Value
friendlyFee :: forall era. TxFee era -> Value
friendlyFee = \case
  TxFeeImplicit TxFeesImplicitInEra era
_ -> Value
"implicit"
  TxFeeExplicit TxFeesExplicitInEra era
_ Lovelace
fee -> Lovelace -> Value
friendlyLovelace Lovelace
fee

friendlyLovelace :: Lovelace -> Aeson.Value
friendlyLovelace :: Lovelace -> Value
friendlyLovelace (Lovelace Integer
value) = Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
textShow Integer
value forall a. Semigroup a => a -> a -> a
<> Text
" Lovelace"

friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value
friendlyMintValue :: forall era. TxMintValue ViewTx era -> Value
friendlyMintValue = \case
  TxMintValue ViewTx era
TxMintNone -> Value
Null
  TxMintValue MultiAssetSupportedInEra era
_ Value
v BuildTxWith ViewTx (Map PolicyId (ScriptWitness WitCtxMint era))
_ -> Value -> Value
friendlyValue Value
v

friendlyTxOutValue :: TxOutValue era -> Aeson.Value
friendlyTxOutValue :: forall era. TxOutValue era -> Value
friendlyTxOutValue = \case
  TxOutAdaOnly OnlyAdaSupportedInEra era
_ Lovelace
lovelace -> Lovelace -> Value
friendlyLovelace Lovelace
lovelace
  TxOutValue MultiAssetSupportedInEra era
_ Value
v -> Value -> Value
friendlyValue Value
v

friendlyValue :: Api.Value -> Aeson.Value
friendlyValue :: Value -> Value
friendlyValue Value
v =
  [Pair] -> Value
object
    [ case ValueNestedBundle
bundle of
        ValueNestedBundleAda Quantity
q -> Key
"lovelace" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Quantity
q
        ValueNestedBundle PolicyId
policy Map AssetName Quantity
assets ->
          Text -> Key
Aeson.fromText (PolicyId -> Text
friendlyPolicyId PolicyId
policy) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall {a}. Map AssetName a -> Map Text a
friendlyAssets Map AssetName Quantity
assets
    | ValueNestedBundle
bundle <- [ValueNestedBundle]
bundles
    ]
 where

  ValueNestedRep [ValueNestedBundle]
bundles = Value -> ValueNestedRep
valueToNestedRep Value
v

  friendlyPolicyId :: PolicyId -> Text
friendlyPolicyId = (Text
"policy " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText

  friendlyAssets :: Map AssetName a -> Map Text a
friendlyAssets = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys AssetName -> Text
friendlyAssetName

  friendlyAssetName :: AssetName -> Text
friendlyAssetName = \case
    AssetName
"" -> Text
"default asset"
    name :: AssetName
name@(AssetName ByteString
nameBS) ->
      Text
"asset " forall a. Semigroup a => a -> a -> a
<> forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText AssetName
name forall a. Semigroup a => a -> a -> a
<> Text
nameAsciiSuffix
     where
      nameAsciiSuffix :: Text
nameAsciiSuffix
        | Bool
nameIsAscii = Text
" (" forall a. Semigroup a => a -> a -> a
<> Text
nameAscii forall a. Semigroup a => a -> a -> a
<> Text
")"
        | Bool
otherwise = Text
""
      nameIsAscii :: Bool
nameIsAscii = (Char -> Bool) -> ByteString -> Bool
BSC.all (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c) ByteString
nameBS
      nameAscii :: Text
nameAscii = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
nameBS

friendlyMetadata :: TxMetadataInEra era -> Aeson.Value
friendlyMetadata :: forall era. TxMetadataInEra era -> Value
friendlyMetadata = \case
  TxMetadataInEra era
TxMetadataNone -> Value
Null
  TxMetadataInEra TxMetadataSupportedInEra era
_ (TxMetadata Map Word64 TxMetadataValue
m) -> forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ TxMetadataValue -> Value
friendlyMetadataValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Word64 TxMetadataValue
m

friendlyMetadataValue :: TxMetadataValue -> Aeson.Value
friendlyMetadataValue :: TxMetadataValue -> Value
friendlyMetadataValue = \case
  TxMetaNumber Integer
int -> forall a. ToJSON a => a -> Value
toJSON Integer
int
  TxMetaBytes ByteString
bytes -> Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
textShow ByteString
bytes
  TxMetaList [TxMetadataValue]
lst -> [Value] -> Value
array forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map TxMetadataValue -> Value
friendlyMetadataValue [TxMetadataValue]
lst
  TxMetaMap [(TxMetadataValue, TxMetadataValue)]
m ->
    [Value] -> Value
array
      [[Value] -> Value
array [TxMetadataValue -> Value
friendlyMetadataValue TxMetadataValue
k, TxMetadataValue -> Value
friendlyMetadataValue TxMetadataValue
v] | (TxMetadataValue
k, TxMetadataValue
v) <- [(TxMetadataValue, TxMetadataValue)]
m]
  TxMetaText Text
text -> forall a. ToJSON a => a -> Value
toJSON Text
text

friendlyAuxScripts :: TxAuxScripts era -> Aeson.Value
friendlyAuxScripts :: forall era. TxAuxScripts era -> Value
friendlyAuxScripts = \case
  TxAuxScripts era
TxAuxScriptsNone -> Value
Null
  TxAuxScripts AuxScriptsSupportedInEra era
_ [ScriptInEra era]
scripts -> Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
textShow [ScriptInEra era]
scripts

friendlyReferenceInputs :: TxInsReference build era -> Aeson.Value
friendlyReferenceInputs :: forall build era. TxInsReference build era -> Value
friendlyReferenceInputs TxInsReference build era
TxInsReferenceNone = Value
Null
friendlyReferenceInputs (TxInsReference ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ [TxIn]
txins) = forall a. ToJSON a => a -> Value
toJSON [TxIn]
txins

friendlyInputs :: [(TxIn, build)] -> Aeson.Value
friendlyInputs :: forall build. [(TxIn, build)] -> Value
friendlyInputs = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst

friendlyCollateralInputs :: TxInsCollateral era -> Aeson.Value
friendlyCollateralInputs :: forall era. TxInsCollateral era -> Value
friendlyCollateralInputs = \case
  TxInsCollateral era
TxInsCollateralNone -> Value
Null
  TxInsCollateral CollateralSupportedInEra era
_ [TxIn]
txins -> forall a. ToJSON a => a -> Value
toJSON [TxIn]
txins