{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.CLI.Run.Friendly (friendlyTxBS, friendlyTxBodyBS) where
import Cardano.Prelude
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 qualified Data.ByteString.Char8 as BSC
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import Data.Yaml (array)
import Data.Yaml.Pretty (setConfCompare)
import qualified Data.Yaml.Pretty as Yaml
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 Cardano.CLI.Helpers (textShow)
import qualified Cardano.Ledger.Shelley.API as Shelley
yamlConfig :: Yaml.Config
yamlConfig :: Config
yamlConfig = Config
Yaml.defConfig Config -> (Config -> Config) -> Config
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Ordering) -> Config -> Config
setConfCompare Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
friendlyTxBS :: IsCardanoEra era => CardanoEra era -> Tx era -> ByteString
friendlyTxBS :: CardanoEra era -> Tx era -> ByteString
friendlyTxBS CardanoEra era
era = Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Yaml.encodePretty Config
yamlConfig (Value -> ByteString) -> (Tx era -> Value) -> Tx era -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Pair] -> Value
object ([Pair] -> Value) -> (Tx era -> [Pair]) -> Tx era -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CardanoEra era -> Tx era -> [Pair]
forall era. IsCardanoEra era => CardanoEra era -> Tx era -> [Pair]
friendlyTx CardanoEra era
era
friendlyTx :: IsCardanoEra era => CardanoEra era -> Tx era -> [Aeson.Pair]
friendlyTx :: CardanoEra era -> Tx era -> [Pair]
friendlyTx CardanoEra era
era (Tx TxBody era
body [KeyWitness era]
witnesses) =
(Key
"witnesses" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (KeyWitness era -> Value) -> [KeyWitness era] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map KeyWitness era -> Value
forall era. KeyWitness era -> Value
friendlyKeyWitness [KeyWitness era]
witnesses) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: CardanoEra era -> TxBody era -> [Pair]
forall era.
IsCardanoEra era =>
CardanoEra era -> TxBody era -> [Pair]
friendlyTxBody CardanoEra era
era TxBody era
body
friendlyKeyWitness :: KeyWitness era -> Aeson.Value
friendlyKeyWitness :: KeyWitness era -> Value
friendlyKeyWitness =
[Pair] -> Value
object
([Pair] -> Value)
-> (KeyWitness era -> [Pair]) -> KeyWitness era -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
ByronKeyWitness TxInWitness
txInWitness -> [Key
"Byron witness" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxInWitness -> Text
forall a. Show a => a -> Text
textShow TxInWitness
txInWitness]
ShelleyBootstrapWitness ShelleyBasedEra era
_era BootstrapWitness StandardCrypto
bootstrapWitness ->
[Key
"bootstrap witness" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BootstrapWitness StandardCrypto -> Text
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VKey 'Witness StandardCrypto -> Text
forall a. Show a => a -> Text
textShow VKey 'Witness StandardCrypto
key, Key
"signature" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SignedDSIGN Ed25519DSIGN (Hash Blake2b_256 EraIndependentTxBody)
-> Text
forall a. Show a => a -> Text
textShow SignedDSIGN
StandardCrypto (Hash StandardCrypto EraIndependentTxBody)
SignedDSIGN Ed25519DSIGN (Hash Blake2b_256 EraIndependentTxBody)
signature]
friendlyTxBodyBS
:: IsCardanoEra era => CardanoEra era -> TxBody era -> ByteString
friendlyTxBodyBS :: CardanoEra era -> TxBody era -> ByteString
friendlyTxBodyBS CardanoEra era
era =
Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Yaml.encodePretty Config
yamlConfig (Value -> ByteString)
-> (TxBody era -> Value) -> TxBody era -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Pair] -> Value
object ([Pair] -> Value) -> (TxBody era -> [Pair]) -> TxBody era -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CardanoEra era -> TxBody era -> [Pair]
forall era.
IsCardanoEra era =>
CardanoEra era -> TxBody era -> [Pair]
friendlyTxBody CardanoEra era
era
friendlyTxBody
:: IsCardanoEra era => CardanoEra era -> TxBody era -> [Aeson.Pair]
friendlyTxBody :: 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
, 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" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxAuxScripts era -> Value
forall era. TxAuxScripts era -> Value
friendlyAuxScripts TxAuxScripts era
txAuxScripts
, Key
"certificates" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxCertificates ViewTx era -> Value
forall era. TxCertificates ViewTx era -> Value
friendlyCertificates TxCertificates ViewTx era
txCertificates
, Key
"collateral inputs" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxInsCollateral era -> Value
forall era. TxInsCollateral era -> Value
friendlyCollateralInputs TxInsCollateral era
txInsCollateral
, Key
"era" Key -> CardanoEra era -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CardanoEra era
era
, Key
"fee" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxFee era -> Value
forall era. TxFee era -> Value
friendlyFee TxFee era
txFee
, Key
"inputs" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxIns ViewTx era -> Value
forall build. [(TxIn, build)] -> Value
friendlyInputs TxIns ViewTx era
txIns
, Key
"metadata" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxMetadataInEra era -> Value
forall era. TxMetadataInEra era -> Value
friendlyMetadata TxMetadataInEra era
txMetadata
, Key
"mint" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxMintValue ViewTx era -> Value
forall era. TxMintValue ViewTx era -> Value
friendlyMintValue TxMintValue ViewTx era
txMintValue
, Key
"outputs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (TxOut CtxTx era -> Value) -> [TxOut CtxTx era] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map TxOut CtxTx era -> Value
forall era. IsCardanoEra era => TxOut CtxTx era -> Value
friendlyTxOut [TxOut CtxTx era]
txOuts
, Key
"reference inputs" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxInsReference ViewTx era -> Value
forall build era. TxInsReference build era -> Value
friendlyReferenceInputs TxInsReference ViewTx era
txInsReference
, Key
"required signers (payment key hashes needed for scripts)" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
TxExtraKeyWitnesses era -> Value
forall era. TxExtraKeyWitnesses era -> Value
friendlyExtraKeyWits TxExtraKeyWitnesses era
txExtraKeyWits
, Key
"update proposal" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxUpdateProposal era -> Value
forall era. TxUpdateProposal era -> Value
friendlyUpdateProposal TxUpdateProposal era
txUpdateProposal
, Key
"validity range" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CardanoEra era
-> (TxValidityLowerBound era, TxValidityUpperBound era) -> Value
forall era.
CardanoEra era
-> (TxValidityLowerBound era, TxValidityUpperBound era) -> Value
friendlyValidityRange CardanoEra era
era (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange
, Key
"withdrawals" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxWithdrawals ViewTx era -> Value
forall era. TxWithdrawals ViewTx era -> Value
friendlyWithdrawals TxWithdrawals ViewTx era
txWithdrawals
]
friendlyExtraKeyWits :: TxExtraKeyWitnesses era -> Aeson.Value
= \case
TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone -> Value
Null
TxExtraKeyWitnesses TxExtraKeyWitnessesSupportedInEra era
_supported [Hash PaymentKey]
paymentKeyHashes ->
[Text] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Text] -> Value) -> [Text] -> Value
forall a b. (a -> b) -> a -> b
$ (Hash PaymentKey -> Text) -> [Hash PaymentKey] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Hash PaymentKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText [Hash PaymentKey]
paymentKeyHashes
pattern ShelleyTtl
:: SlotNo -> (TxValidityLowerBound era, TxValidityUpperBound era)
pattern $mShelleyTtl :: forall r era.
(TxValidityLowerBound era, TxValidityUpperBound era)
-> (SlotNo -> r) -> (Void# -> r) -> r
ShelleyTtl ttl <-
( TxValidityNoLowerBound
, TxValidityUpperBound ValidityUpperBoundInShelleyEra ttl
)
friendlyValidityRange
:: CardanoEra era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> Aeson.Value
friendlyValidityRange :: CardanoEra era
-> (TxValidityLowerBound era, TxValidityUpperBound era) -> Value
friendlyValidityRange CardanoEra era
era = \case
ShelleyTtl SlotNo
ttl -> [Pair] -> Value
object [Key
"time to live" Key -> SlotNo -> Pair
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" Key -> Value -> Pair
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 -> SlotNo -> Value
forall a. ToJSON a => a -> Value
toJSON SlotNo
s
, Key
"upper bound" Key -> Value -> Pair
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 -> SlotNo -> Value
forall a. ToJSON a => a -> Value
toJSON SlotNo
s
]
| Bool
otherwise -> Value
Null
where
isLowerBoundSupported :: Bool
isLowerBoundSupported = Maybe (ValidityLowerBoundSupportedInEra era) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ValidityLowerBoundSupportedInEra era) -> Bool)
-> Maybe (ValidityLowerBoundSupportedInEra era) -> Bool
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
forall era.
CardanoEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
validityLowerBoundSupportedInEra CardanoEra era
era
isUpperBoundSupported :: Bool
isUpperBoundSupported = Maybe (ValidityUpperBoundSupportedInEra era) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ValidityUpperBoundSupportedInEra era) -> Bool)
-> Maybe (ValidityUpperBoundSupportedInEra era) -> Bool
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
forall era.
CardanoEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
validityUpperBoundSupportedInEra CardanoEra era
era
friendlyWithdrawals :: TxWithdrawals ViewTx era -> Aeson.Value
friendlyWithdrawals :: 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 ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
Key
"address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StakeAddress -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress StakeAddress
addr Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:
Key
"amount" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
amount Pair -> [Pair] -> [Pair]
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" Key -> Network -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Network
net
, StakeCredential -> Pair
friendlyStakeCredential (StakeCredential -> Pair) -> StakeCredential -> Pair
forall a b. (a -> b) -> a -> b
$ StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential StakeCredential StandardCrypto
cred
]
friendlyTxOut :: IsCardanoEra era => TxOut CtxTx era -> Aeson.Value
friendlyTxOut :: TxOut CtxTx era -> Value
friendlyTxOut (TxOut AddressInEra era
addr TxOutValue era
amount TxOutDatum CtxTx era
mdatum ReferenceScript era
script) =
[Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
case AddressInEra era
addr of
AddressInEra AddressTypeInEra addrtype era
ByronAddressInAnyEra Address addrtype
byronAdr ->
[ Key
"address era" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Byron"
, Key
"address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Address addrtype -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address addrtype
byronAdr
, Key
"amount" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxOutValue era -> Value
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) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:
[ Key
"address era" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"Shelley"
, Key
"network" Key -> Network -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Network
net
, Key
"address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Address addrtype -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address addrtype
saddr
, Key
"amount" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxOutValue era -> Value
forall era. TxOutValue era -> Value
friendlyTxOutValue TxOutValue era
amount
, Key
"stake reference" Key -> Value -> Pair
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" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxOutDatum CtxTx era -> Value
forall era. TxOutDatum CtxTx era -> Value
renderDatum TxOutDatum CtxTx era
mdatum
| Maybe (ScriptDataSupportedInEra era) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ScriptDataSupportedInEra era) -> Bool)
-> Maybe (ScriptDataSupportedInEra era) -> Bool
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
forall era. CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra (CardanoEra era -> Maybe (ScriptDataSupportedInEra era))
-> CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra ShelleyBasedEra era
sbe
]
sinceAlonzo :: [Pair]
sinceAlonzo = [Key
"reference script" Key -> ReferenceScript era -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ReferenceScript era
script]
in [Pair]
preAlonzo [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
datum [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
sinceAlonzo
where
renderDatum :: TxOutDatum CtxTx era -> Aeson.Value
renderDatum :: TxOutDatum CtxTx era -> Value
renderDatum TxOutDatum CtxTx era
TxOutDatumNone = Value
Aeson.Null
renderDatum (TxOutDatumHash ScriptDataSupportedInEra era
_ Hash ScriptData
h) =
Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Hash ScriptData -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash ScriptData
h
renderDatum (TxOutDatumInTx ScriptDataSupportedInEra era
_ ScriptData
sData) =
ScriptDataJsonSchema -> ScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema ScriptData
sData
renderDatum (TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ ScriptData
sData) =
ScriptDataJsonSchema -> ScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema ScriptData
sData
friendlyStakeReference :: StakeAddressReference -> Aeson.Value
friendlyStakeReference :: StakeAddressReference -> Value
friendlyStakeReference = \case
StakeAddressReference
NoStakeAddress -> Value
Null
StakeAddressByPointer StakeAddressPointer
ptr -> Text -> Value
String (StakeAddressPointer -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show StakeAddressPointer
ptr)
StakeAddressByValue StakeCredential
cred -> [Pair] -> Value
object [StakeCredential -> Pair
friendlyStakeCredential StakeCredential
cred]
friendlyUpdateProposal :: TxUpdateProposal era -> Aeson.Value
friendlyUpdateProposal :: 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" Key -> EpochNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= EpochNo
epoch
, Key
"updates" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
[ [Pair] -> Value
object
[ Key
"genesis key hash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Hash GenesisKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash GenesisKey
genesisKeyHash
, Key
"update" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ProtocolParametersUpdate -> Value
friendlyProtocolParametersUpdate ProtocolParametersUpdate
parameterUpdate
]
| (Hash GenesisKey
genesisKeyHash, ProtocolParametersUpdate
parameterUpdate) <- Map (Hash GenesisKey) ProtocolParametersUpdate
-> [(Hash GenesisKey, ProtocolParametersUpdate)]
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
} =
[Pair] -> Value
object ([Pair] -> Value)
-> ([Maybe Pair] -> [Pair]) -> [Maybe Pair] -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Pair] -> Value) -> [Maybe Pair] -> Value
forall a b. (a -> b) -> a -> b
$
[ Maybe (Natural, Natural)
protocolUpdateProtocolVersion Maybe (Natural, Natural)
-> ((Natural, Natural) -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Natural
major, Natural
minor) ->
Key
"protocol version" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Natural -> Text
forall a. Show a => a -> Text
textShow Natural
major Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Natural -> Text
forall a. Show a => a -> Text
textShow Natural
minor)
, Maybe Rational
protocolUpdateDecentralization Maybe Rational -> (Rational -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Key
"decentralization parameter" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Rational -> Value) -> Rational -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Value
friendlyRational
, Maybe (Maybe PraosNonce)
protocolUpdateExtraPraosEntropy Maybe (Maybe PraosNonce)
-> (Maybe PraosNonce -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Key
"extra entropy" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair)
-> (Maybe PraosNonce -> Value) -> Maybe PraosNonce -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Value -> (PraosNonce -> Value) -> Maybe PraosNonce -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
"reset" PraosNonce -> Value
forall a. ToJSON a => a -> Value
toJSON
, Maybe Natural
protocolUpdateMaxBlockHeaderSize Maybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max block header size" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Natural
protocolUpdateMaxBlockBodySizeMaybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max block body size" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Natural
protocolUpdateMaxTxSize Maybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max transaction size" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Natural
protocolUpdateTxFeeFixed Maybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"transaction fee constant" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Natural
protocolUpdateTxFeePerByte Maybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"transaction fee linear per byte" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Lovelace
protocolUpdateMinUTxOValue Maybe Lovelace -> (Lovelace -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"min UTxO value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Lovelace -> Value) -> Lovelace -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lovelace -> Value
friendlyLovelace
, Maybe Lovelace
protocolUpdateStakeAddressDeposit Maybe Lovelace -> (Lovelace -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Key
"key registration deposit" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Lovelace -> Value) -> Lovelace -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lovelace -> Value
friendlyLovelace
, Maybe Lovelace
protocolUpdateStakePoolDeposit Maybe Lovelace -> (Lovelace -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Key
"pool registration deposit" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Lovelace -> Value) -> Lovelace -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lovelace -> Value
friendlyLovelace
, Maybe Lovelace
protocolUpdateMinPoolCost Maybe Lovelace -> (Lovelace -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"min pool cost" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Lovelace -> Value) -> Lovelace -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lovelace -> Value
friendlyLovelace
, Maybe EpochNo
protocolUpdatePoolRetireMaxEpoch Maybe EpochNo -> (EpochNo -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"pool retirement epoch boundary" Key -> EpochNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Natural
protocolUpdateStakePoolTargetNum Maybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"number of pools" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Rational
protocolUpdatePoolPledgeInfluence Maybe Rational -> (Rational -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Key
"pool influence" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Rational -> Value) -> Rational -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Value
friendlyRational
, Maybe Rational
protocolUpdateMonetaryExpansion Maybe Rational -> (Rational -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Key
"monetary expansion" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Rational -> Value) -> Rational -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Value
friendlyRational
, Maybe Rational
protocolUpdateTreasuryCut Maybe Rational -> (Rational -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"treasury expansion" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Rational -> Value) -> Rational -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Value
friendlyRational
, Maybe Lovelace
protocolUpdateUTxOCostPerWord Maybe Lovelace -> (Lovelace -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Key
"UTxO storage cost per unit" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair) -> (Lovelace -> Value) -> Lovelace -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lovelace -> Value
friendlyLovelace
, Maybe Natural
protocolUpdateCollateralPercent Maybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Key
"collateral inputs share" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> (Natural -> Text) -> Natural -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%") (Text -> Text) -> (Natural -> Text) -> Natural -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> Text
forall a. Show a => a -> Text
textShow
, Maybe ExecutionUnits
protocolUpdateMaxBlockExUnits Maybe ExecutionUnits -> (ExecutionUnits -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max block execution units" Key -> ExecutionUnits -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Natural
protocolUpdateMaxCollateralInputs Maybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max collateral inputs" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe ExecutionUnits
protocolUpdateMaxTxExUnits Maybe ExecutionUnits -> (ExecutionUnits -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max transaction execution units" Key -> ExecutionUnits -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe Natural
protocolUpdateMaxValueSize Maybe Natural -> (Natural -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"max value size" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
, Maybe ExecutionUnitPrices
protocolUpdatePrices Maybe ExecutionUnitPrices
-> (ExecutionUnitPrices -> Pair) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key
"execution prices" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Value -> Pair)
-> (ExecutionUnitPrices -> Value) -> ExecutionUnitPrices -> Pair
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExecutionUnitPrices -> Value
friendlyPrices
]
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" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
friendlyRational Rational
priceExecutionMemory
, Key
"steps" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
friendlyRational Rational
priceExecutionSteps
]
friendlyCertificates :: TxCertificates ViewTx era -> Aeson.Value
friendlyCertificates :: 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 ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (Certificate -> Value) -> [Certificate] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Certificate -> Value
friendlyCertificate [Certificate]
cs
friendlyCertificate :: Certificate -> Aeson.Value
friendlyCertificate :: Certificate -> Value
friendlyCertificate =
[Pair] -> Value
object
([Pair] -> Value)
-> (Certificate -> [Pair]) -> Certificate -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [])
(Pair -> [Pair]) -> (Certificate -> Pair) -> Certificate -> [Pair]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
StakeAddressRegistrationCertificate StakeCredential
credential ->
Key
"stake address registration"
Key -> Value -> Pair
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"
Key -> Value -> Pair
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"
Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [StakeCredential -> Pair
friendlyStakeCredential StakeCredential
credential, Key
"pool" Key -> PoolId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolId
poolId]
StakePoolRegistrationCertificate StakePoolParameters
parameters ->
Key
"stake pool registration" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StakePoolParameters -> Value
friendlyStakePoolParameters StakePoolParameters
parameters
StakePoolRetirementCertificate PoolId
poolId EpochNo
epochNo ->
Key
"stake pool retirement" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"pool" Key -> PoolId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolId
poolId, Key
"epoch" Key -> EpochNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= EpochNo
epochNo]
GenesisKeyDelegationCertificate
Hash GenesisKey
genesisKeyHash
Hash GenesisDelegateKey
delegateKeyHash
Hash VrfKey
vrfKeyHash ->
Key
"genesis key delegation"
Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
[ Key
"genesis key hash"
Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Hash GenesisKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash GenesisKey
genesisKeyHash,
Key
"delegate key hash"
Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Hash GenesisDelegateKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash GenesisDelegateKey
delegateKeyHash,
Key
"VRF key hash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Hash VrfKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash VrfKey
vrfKeyHash
]
MIRCertificate MIRPot
pot MIRTarget
target ->
Key
"MIR" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"pot" Key -> Value -> Pair
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" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
[ [Pair] -> Value
object
[ StakeCredential -> Pair
friendlyStakeCredential StakeCredential
credential
, Key
"amount" Key -> Value -> Pair
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" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
amount
SendToTreasuryMIR Lovelace
amount -> Key
"send to treasury" Key -> Value -> Pair
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Hash StakeKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash StakeKey
keyHash
StakeCredentialByScript ScriptHash
scriptHash ->
Key
"stake credential script hash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptHash -> Text
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Hash PaymentKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash PaymentKey
keyHash
PaymentCredentialByScript ScriptHash
scriptHash ->
Key
"payment credential script hash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptHash -> Text
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" Key -> PoolId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolId
stakePoolId
, Key
"VRF key hash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Hash VrfKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash VrfKey
stakePoolVRF
, Key
"cost" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
stakePoolCost
, Key
"margin" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Rational -> Value
friendlyRational Rational
stakePoolMargin
, Key
"reward account" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object (StakeAddress -> [Pair]
friendlyStakeAddress StakeAddress
stakePoolRewardAccount)
, Key
"pledge" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace -> Value
friendlyLovelace Lovelace
stakePoolPledge
, Key
"owners (stake key hashes)"
Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Hash StakeKey -> Text) -> [Hash StakeKey] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Hash StakeKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText [Hash StakeKey]
stakePoolOwners
, Key
"relays" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (StakePoolRelay -> Text) -> [StakePoolRelay] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map StakePoolRelay -> Text
forall a. Show a => a -> Text
textShow [StakePoolRelay]
stakePoolRelays
, Key
"metadata" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (StakePoolMetadataReference -> Text)
-> Maybe StakePoolMetadataReference -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StakePoolMetadataReference -> Text
forall a. Show a => a -> Text
textShow Maybe StakePoolMetadataReference
stakePoolMetadata
]
friendlyRational :: Rational -> Aeson.Value
friendlyRational :: Rational -> Value
friendlyRational Rational
r =
Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
case Integer
d of
Integer
1 -> Integer -> Text
forall a. Show a => a -> Text
textShow Integer
n
Integer
_ -> Integer -> Text
forall a. Show a => a -> Text
textShow Integer
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
textShow Integer
d
where
n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r
d :: Integer
d = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r
friendlyFee :: TxFee era -> Aeson.Value
friendlyFee :: 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 (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Text
forall a. Show a => a -> Text
textShow Integer
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Lovelace"
friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value
friendlyMintValue :: 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 :: 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" Key -> Quantity -> Pair
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) Key -> Map Text Quantity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map AssetName Quantity -> Map Text Quantity
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (PolicyId -> Text) -> PolicyId -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PolicyId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText
friendlyAssets :: Map AssetName a -> Map Text a
friendlyAssets = (AssetName -> Text) -> Map AssetName a -> Map Text a
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssetName -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText AssetName
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameAsciiSuffix
where
nameAsciiSuffix :: Text
nameAsciiSuffix
| Bool
nameIsAscii = Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameAscii Text -> Text -> Text
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
nameBS
friendlyMetadata :: TxMetadataInEra era -> Aeson.Value
friendlyMetadata :: TxMetadataInEra era -> Value
friendlyMetadata = \case
TxMetadataInEra era
TxMetadataNone -> Value
Null
TxMetadataInEra TxMetadataSupportedInEra era
_ (TxMetadata Map Word64 TxMetadataValue
m) -> Map Word64 Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Map Word64 Value -> Value) -> Map Word64 Value -> Value
forall a b. (a -> b) -> a -> b
$ TxMetadataValue -> Value
friendlyMetadataValue (TxMetadataValue -> Value)
-> Map Word64 TxMetadataValue -> Map Word64 Value
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 -> Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
int
TxMetaBytes ByteString
bytes -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a. Show a => a -> Text
textShow ByteString
bytes
TxMetaList [TxMetadataValue]
lst -> [Value] -> Value
array ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (TxMetadataValue -> Value) -> [TxMetadataValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
text
friendlyAuxScripts :: TxAuxScripts era -> Aeson.Value
friendlyAuxScripts :: TxAuxScripts era -> Value
friendlyAuxScripts = \case
TxAuxScripts era
TxAuxScriptsNone -> Value
Null
TxAuxScripts AuxScriptsSupportedInEra era
_ [ScriptInEra era]
scripts -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [ScriptInEra era] -> Text
forall a. Show a => a -> Text
textShow [ScriptInEra era]
scripts
friendlyReferenceInputs :: TxInsReference build era -> Aeson.Value
friendlyReferenceInputs :: TxInsReference build era -> Value
friendlyReferenceInputs TxInsReference build era
TxInsReferenceNone = Value
Null
friendlyReferenceInputs (TxInsReference ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ [TxIn]
txins) = [TxIn] -> Value
forall a. ToJSON a => a -> Value
toJSON [TxIn]
txins
friendlyInputs :: [(TxIn, build)] -> Aeson.Value
friendlyInputs :: [(TxIn, build)] -> Value
friendlyInputs = [TxIn] -> Value
forall a. ToJSON a => a -> Value
toJSON ([TxIn] -> Value)
-> ([(TxIn, build)] -> [TxIn]) -> [(TxIn, build)] -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TxIn, build) -> TxIn) -> [(TxIn, build)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TxIn, build) -> TxIn
forall a b. (a, b) -> a
fst
friendlyCollateralInputs :: TxInsCollateral era -> Aeson.Value
friendlyCollateralInputs :: TxInsCollateral era -> Value
friendlyCollateralInputs = \case
TxInsCollateral era
TxInsCollateralNone -> Value
Null
TxInsCollateral CollateralSupportedInEra era
_ [TxIn]
txins -> [TxIn] -> Value
forall a. ToJSON a => a -> Value
toJSON [TxIn]
txins