{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans  #-}

module Cardano.Tracing.OrphanInstances.Shelley () where

import           Cardano.Prelude

import           Data.Aeson (ToJSONKey (..), ToJSONKeyFunction (..))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson
import qualified Data.HashMap.Strict as HMS
import qualified Data.Set as Set
import           Data.Scientific (Scientific)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text


import           Cardano.Slotting.Block (BlockNo (..))
import           Cardano.Tracing.OrphanInstances.Common
import           Cardano.Tracing.OrphanInstances.Consensus ()

import           Cardano.Crypto.Hash.Class as Crypto

import           Ouroboros.Consensus.Ledger.SupportsMempool (txId)
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as SupportsMempool
import           Ouroboros.Consensus.Util.Condense (condense)
import           Ouroboros.Network.Block (SlotNo (..), blockHash, blockNo, blockSlot)
import           Ouroboros.Network.Point (WithOrigin, withOriginToMaybe)

import           Ouroboros.Consensus.Shelley.Ledger hiding (TxId)
import           Ouroboros.Consensus.Shelley.Ledger.Inspect
import           Ouroboros.Consensus.Shelley.Protocol (TPraosCannotForge (..))
import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey

import qualified Cardano.Ledger.Crypto as Core
import qualified Cardano.Ledger.Core as Core

-- TODO: this should be exposed via Cardano.Api
import           Shelley.Spec.Ledger.API
import           Shelley.Spec.Ledger.Coin (DeltaCoin (..))
import           Shelley.Spec.Ledger.BlockChain (LastAppliedBlock (..))
import           Shelley.Spec.Ledger.PParams (PParamsUpdate)

import           Shelley.Spec.Ledger.MetaData (MetaDataHash (..))
import           Shelley.Spec.Ledger.STS.Bbody
import           Shelley.Spec.Ledger.STS.Chain
import           Shelley.Spec.Ledger.STS.Deleg
import           Shelley.Spec.Ledger.STS.Delegs
import           Shelley.Spec.Ledger.STS.Delpl
import           Shelley.Spec.Ledger.STS.Epoch
import           Shelley.Spec.Ledger.STS.Ledger
import           Shelley.Spec.Ledger.STS.Ledgers
import           Shelley.Spec.Ledger.STS.Mir
import           Shelley.Spec.Ledger.STS.NewEpoch
import           Shelley.Spec.Ledger.STS.Newpp
import           Shelley.Spec.Ledger.STS.Ocert
import           Shelley.Spec.Ledger.STS.Overlay
import           Shelley.Spec.Ledger.STS.Pool
import           Shelley.Spec.Ledger.STS.PoolReap
import           Shelley.Spec.Ledger.STS.Ppup
import           Shelley.Spec.Ledger.STS.Rupd
import           Shelley.Spec.Ledger.STS.Snap
import           Shelley.Spec.Ledger.STS.Tick
import           Shelley.Spec.Ledger.STS.Updn
import           Shelley.Spec.Ledger.STS.Utxo
import           Shelley.Spec.Ledger.STS.Utxow

{- HLINT ignore "Use :" -}

--
-- | instances of @ToObject@
--
-- NOTE: this list is sorted in roughly topological order.

instance ShelleyBasedEra era => ToObject (GenTx (ShelleyBlock era)) where
  toObject :: TracingVerbosity -> GenTx (ShelleyBlock era) -> Object
toObject TracingVerbosity
verb GenTx (ShelleyBlock era)
tx =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
        [ Text
"txid" Text -> TxId (GenTx (ShelleyBlock era)) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GenTx (ShelleyBlock era) -> TxId (GenTx (ShelleyBlock era))
forall tx. HasTxId tx => tx -> TxId tx
txId GenTx (ShelleyBlock era)
tx ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"tx"   Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GenTx (ShelleyBlock era) -> String
forall a. Condense a => a -> String
condense GenTx (ShelleyBlock era)
tx | TracingVerbosity
verb TracingVerbosity -> TracingVerbosity -> Bool
forall a. Eq a => a -> a -> Bool
== TracingVerbosity
MaximalVerbosity ]

instance ToJSON (SupportsMempool.TxId (GenTx (ShelleyBlock era))) where
  toJSON :: TxId (GenTx (ShelleyBlock era)) -> Value
toJSON TxId (GenTx (ShelleyBlock era))
i = String -> Value
forall a. ToJSON a => a -> Value
toJSON (TxId (GenTx (ShelleyBlock era)) -> String
forall a. Condense a => a -> String
condense TxId (GenTx (ShelleyBlock era))
i)

instance ShelleyBasedEra era => ToObject (Header (ShelleyBlock era)) where
  toObject :: TracingVerbosity -> Header (ShelleyBlock era) -> Object
toObject TracingVerbosity
_verb Header (ShelleyBlock era)
b = [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
        [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ShelleyBlock"
        , Text
"hash" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ShelleyHash (Crypto era) -> String
forall a. Condense a => a -> String
condense (Header (ShelleyBlock era) -> HeaderHash (Header (ShelleyBlock era))
forall b. HasHeader b => b -> HeaderHash b
blockHash Header (ShelleyBlock era)
b)
        , Text
"slotNo" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo -> String
forall a. Condense a => a -> String
condense (Header (ShelleyBlock era) -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot Header (ShelleyBlock era)
b)
        , Text
"blockNo" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockNo -> String
forall a. Condense a => a -> String
condense (Header (ShelleyBlock era) -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo Header (ShelleyBlock era)
b)
--      , "delegate" .= condense (headerSignerVk h)
        ]

instance ( ShelleyBasedEra era
         , ToObject (PredicateFailure (UTXO era))
         , ToObject (PredicateFailure (UTXOW era))
         ) => ToObject (ApplyTxError era) where
  toObject :: TracingVerbosity -> ApplyTxError era -> Object
toObject TracingVerbosity
verb (ApplyTxError [PredicateFailure (LEDGERS era)]
predicateFailures) =
    [Object] -> Object
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HMS.unions ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ (LedgersPredicateFailure era -> Object)
-> [LedgersPredicateFailure era] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> LedgersPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb) [PredicateFailure (LEDGERS era)]
[LedgersPredicateFailure era]
predicateFailures

instance ToObject (TPraosCannotForge era) where
  toObject :: TracingVerbosity -> TPraosCannotForge era -> Object
toObject TracingVerbosity
_verb (TPraosCannotForgeKeyNotUsableYet KESPeriod
wallClockPeriod KESPeriod
keyStartPeriod) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TPraosCannotForgeKeyNotUsableYet"
      , Text
"keyStart" Text -> KESPeriod -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KESPeriod
keyStartPeriod
      , Text
"wallClock" Text -> KESPeriod -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KESPeriod
wallClockPeriod
      ]
  toObject TracingVerbosity
_verb (TPraosCannotForgeWrongVRF Hash era (VerKeyVRF era)
genDlgVRFHash Hash era (VerKeyVRF era)
coreNodeVRFHash) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"TPraosCannotLeadWrongVRF"
      , Text
"expected" Text -> Hash era (VerKeyVRF era) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash era (VerKeyVRF era)
genDlgVRFHash
      , Text
"actual" Text -> Hash era (VerKeyVRF era) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash era (VerKeyVRF era)
coreNodeVRFHash
      ]

deriving newtype instance ToJSON KESPeriod

instance ToObject HotKey.KESInfo where
  toObject :: TracingVerbosity -> KESInfo -> Object
toObject TracingVerbosity
_verb HotKey.KESInfo { KESPeriod
kesStartPeriod :: KESInfo -> KESPeriod
kesStartPeriod :: KESPeriod
kesStartPeriod, KESPeriod
kesEndPeriod :: KESInfo -> KESPeriod
kesEndPeriod :: KESPeriod
kesEndPeriod, KESEvolution
kesEvolution :: KESInfo -> KESEvolution
kesEvolution :: KESEvolution
kesEvolution } =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"KESInfo"
      , Text
"startPeriod" Text -> KESPeriod -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KESPeriod
kesStartPeriod
      , Text
"endPeriod" Text -> KESPeriod -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KESPeriod
kesEndPeriod
      , Text
"evolution" Text -> KESEvolution -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KESEvolution
kesEvolution
      ]

instance ToObject HotKey.KESEvolutionError where
  toObject :: TracingVerbosity -> KESEvolutionError -> Object
toObject TracingVerbosity
verb (HotKey.KESCouldNotEvolve KESInfo
kesInfo KESPeriod
targetPeriod) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"KESCouldNotEvolve"
      , Text
"kesInfo" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> KESInfo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb KESInfo
kesInfo
      , Text
"targetPeriod" Text -> KESPeriod -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KESPeriod
targetPeriod
      ]
  toObject TracingVerbosity
verb (HotKey.KESKeyAlreadyPoisoned KESInfo
kesInfo KESPeriod
targetPeriod) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject
      [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"KESKeyAlreadyPoisoned"
      , Text
"kesInfo" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> KESInfo -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb KESInfo
kesInfo
      , Text
"targetPeriod" Text -> KESPeriod -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KESPeriod
targetPeriod
      ]

instance ( ShelleyBasedEra era
         , ToObject (PredicateFailure (UTXO era))
         , ToObject (PredicateFailure (UTXOW era))
         ) => ToObject (ShelleyLedgerError era) where
  toObject :: TracingVerbosity -> ShelleyLedgerError era -> Object
toObject TracingVerbosity
verb (BBodyError (BlockTransitionError [PredicateFailure (BBODY era)]
fs)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"BBodyError"
             , Text
"failures" Text -> [Object] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (BbodyPredicateFailure era -> Object)
-> [BbodyPredicateFailure era] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> BbodyPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb) [PredicateFailure (BBODY era)]
[BbodyPredicateFailure era]
fs
             ]

instance ShelleyBasedEra era => ToObject (ShelleyLedgerUpdate era) where
  toObject :: TracingVerbosity -> ShelleyLedgerUpdate era -> Object
toObject TracingVerbosity
verb (ShelleyUpdatedProtocolUpdates [ProtocolUpdate era]
updates) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ShelleyUpdatedProtocolUpdates"
             , Text
"updates" Text -> [Object] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ProtocolUpdate era -> Object) -> [ProtocolUpdate era] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> ProtocolUpdate era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb) [ProtocolUpdate era]
updates
             ]

instance ToObject (ProtocolUpdate crypto) where
  toObject :: TracingVerbosity -> ProtocolUpdate crypto -> Object
toObject TracingVerbosity
verb ProtocolUpdate{UpdateProposal crypto
protocolUpdateProposal :: forall era. ProtocolUpdate era -> UpdateProposal era
protocolUpdateProposal :: UpdateProposal crypto
protocolUpdateProposal, UpdateState (EraCrypto crypto)
protocolUpdateState :: forall era. ProtocolUpdate era -> UpdateState (EraCrypto era)
protocolUpdateState :: UpdateState (EraCrypto crypto)
protocolUpdateState} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"proposal" Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> UpdateProposal crypto -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb UpdateProposal crypto
protocolUpdateProposal
             , Text
"state"    Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> UpdateState (EraCrypto crypto) -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb UpdateState (EraCrypto crypto)
protocolUpdateState
             ]

instance ToObject (UpdateProposal crypto) where
  toObject :: TracingVerbosity -> UpdateProposal crypto -> Object
toObject TracingVerbosity
_verb UpdateProposal{PParamsUpdate crypto
proposalParams :: forall era. UpdateProposal era -> PParamsUpdate era
proposalParams :: PParamsUpdate crypto
proposalParams, Maybe ProtVer
proposalVersion :: forall era. UpdateProposal era -> Maybe ProtVer
proposalVersion :: Maybe ProtVer
proposalVersion, EpochNo
proposalEpoch :: forall era. UpdateProposal era -> EpochNo
proposalEpoch :: EpochNo
proposalEpoch} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"params"  Text -> PParamsUpdate crypto -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PParamsUpdate crypto
proposalParams
             , Text
"version" Text -> Maybe ProtVer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ProtVer
proposalVersion
             , Text
"epoch"   Text -> EpochNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EpochNo
proposalEpoch
             ]

instance ToObject (UpdateState crypto) where
  toObject :: TracingVerbosity -> UpdateState crypto -> Object
toObject TracingVerbosity
_verb UpdateState{[KeyHash 'Genesis crypto]
proposalVotes :: forall c. UpdateState c -> [KeyHash 'Genesis c]
proposalVotes :: [KeyHash 'Genesis crypto]
proposalVotes, Bool
proposalReachedQuorum :: forall c. UpdateState c -> Bool
proposalReachedQuorum :: Bool
proposalReachedQuorum} =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"proposal"      Text -> [KeyHash 'Genesis crypto] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [KeyHash 'Genesis crypto]
proposalVotes
             , Text
"reachedQuorum" Text -> Bool -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
proposalReachedQuorum
             ]

instance ToJSON (PParamsUpdate era) where
  toJSON :: PParamsUpdate era -> Value
toJSON PParamsUpdate era
pp =
    [(Text, Value)] -> Value
Aeson.object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Text
"minFeeA"               Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
x | Natural
x <- StrictMaybe Natural -> [Natural]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"minFeeB"               Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
x | Natural
x <- StrictMaybe Natural -> [Natural]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"maxBlockBodySize"      Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
x | Natural
x <- StrictMaybe Natural -> [Natural]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"maxTxSize"             Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
x | Natural
x <- StrictMaybe Natural -> [Natural]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"maxBlockHeaderSize"    Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
x | Natural
x <- StrictMaybe Natural -> [Natural]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"keyDeposit"            Text -> Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
x | Coin
x <- StrictMaybe Coin -> [Coin]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"poolDeposit"           Text -> Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
x | Coin
x <- StrictMaybe Coin -> [Coin]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"eMax"                  Text -> EpochNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EpochNo
x | EpochNo
x <- StrictMaybe EpochNo -> [EpochNo]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe EpochNo
forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"nOpt"                  Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
x | Natural
x <- StrictMaybe Natural -> [Natural]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"a0" Text -> Scientific -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational Rational
x :: Scientific)
                                       | Rational
x <- StrictMaybe Rational -> [Rational]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Rational
forall (f :: * -> *) era. PParams' f era -> HKD f Rational
_a0 PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"rho"                   Text -> UnitInterval -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UnitInterval
x | UnitInterval
x <- StrictMaybe UnitInterval -> [UnitInterval]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"tau"                   Text -> UnitInterval -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UnitInterval
x | UnitInterval
x <- StrictMaybe UnitInterval -> [UnitInterval]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"decentralisationParam" Text -> UnitInterval -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UnitInterval
x | UnitInterval
x <- StrictMaybe UnitInterval -> [UnitInterval]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"extraEntropy"          Text -> Nonce -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Nonce
x | Nonce
x <- StrictMaybe Nonce -> [Nonce]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"protocolVersion"       Text -> ProtVer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProtVer
x | ProtVer
x <- StrictMaybe ProtVer -> [ProtVer]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"minUTxOValue"          Text -> Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
x | Coin
x <- StrictMaybe Coin -> [Coin]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minUTxOValue PParamsUpdate era
pp) ]
     [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ [ Text
"minPoolCost"           Text -> Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
x | Coin
x <- StrictMaybe Coin -> [Coin]
forall a. StrictMaybe a -> [a]
mbfield (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost PParamsUpdate era
pp) ]
    where
      mbfield :: StrictMaybe a -> [a]
mbfield StrictMaybe a
SNothing  = []
      mbfield (SJust a
x) = [a
x]

instance Core.Crypto crypto => ToObject (ChainTransitionError crypto) where
  toObject :: TracingVerbosity -> ChainTransitionError crypto -> Object
toObject TracingVerbosity
verb (ChainTransitionError [PredicateFailure (PRTCL crypto)]
fs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ChainTransitionError"
             , Text
"failures" Text -> [Object] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (PrtclPredicateFailure crypto -> Object)
-> [PrtclPredicateFailure crypto] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> PrtclPredicateFailure crypto -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb) [PredicateFailure (PRTCL crypto)]
[PrtclPredicateFailure crypto]
fs
             ]

instance ( ShelleyBasedEra era
         , ToObject (PredicateFailure (UTXO era))
         , ToObject (PredicateFailure (UTXOW era))
         ) => ToObject (ChainPredicateFailure era) where
  toObject :: TracingVerbosity -> ChainPredicateFailure era -> Object
toObject TracingVerbosity
_verb (HeaderSizeTooLargeCHAIN Natural
hdrSz Natural
maxHdrSz) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"HeaderSizeTooLarge"
             , Text
"headerSize" Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
hdrSz
             , Text
"maxHeaderSize" Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
maxHdrSz
             ]
  toObject TracingVerbosity
_verb (BlockSizeTooLargeCHAIN Natural
blkSz Natural
maxBlkSz) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"BlockSizeTooLarge"
             , Text
"blockSize" Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
blkSz
             , Text
"maxBlockSize" Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
maxBlkSz
             ]
  toObject TracingVerbosity
_verb (ObsoleteNodeCHAIN Natural
currentPtcl Natural
supportedPtcl) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ObsoleteNode"
             , Text
"explanation" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
explanation
             , Text
"currentProtocol" Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
currentPtcl
             , Text
"supportedProtocol" Text -> Natural -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
supportedPtcl ]
      where
        explanation :: Text
explanation = Text
"A scheduled major protocol version change (hard fork) \
                      \has taken place on the chain, but this node does not \
                      \understand the new major protocol version. This node \
                      \must be upgraded before it can continue with the new \
                      \protocol version."
  toObject TracingVerbosity
verb (BbodyFailure PredicateFailure (BBODY era)
f) = TracingVerbosity -> BbodyPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (BBODY era)
BbodyPredicateFailure era
f
  toObject TracingVerbosity
verb (TickFailure  PredicateFailure (TICK era)
f) = TracingVerbosity -> TickPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (TICK era)
TickPredicateFailure era
f
  toObject TracingVerbosity
verb (PrtclFailure PredicateFailure (PRTCL (Crypto era))
f) = TracingVerbosity -> PrtclPredicateFailure (Crypto era) -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (PRTCL (Crypto era))
PrtclPredicateFailure (Crypto era)
f
  toObject TracingVerbosity
verb (PrtclSeqFailure PrtlSeqFailure (Crypto era)
f) = TracingVerbosity -> PrtlSeqFailure (Crypto era) -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PrtlSeqFailure (Crypto era)
f

instance ToObject (PrtlSeqFailure crypto) where
  toObject :: TracingVerbosity -> PrtlSeqFailure crypto -> Object
toObject TracingVerbosity
_verb (WrongSlotIntervalPrtclSeq (SlotNo Word64
lastSlot) (SlotNo Word64
currSlot)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongSlotInterval"
             , Text
"lastSlot" Text -> Word64 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
lastSlot
             , Text
"currentSlot" Text -> Word64 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
currSlot
             ]
  toObject TracingVerbosity
_verb (WrongBlockNoPrtclSeq WithOrigin (LastAppliedBlock crypto)
lab BlockNo
currentBlockNo) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongBlockNo"
             , Text
"lastAppliedBlockNo" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= WithOrigin (LastAppliedBlock crypto) -> Text
forall crypto. WithOrigin (LastAppliedBlock crypto) -> Text
showLastAppBlockNo WithOrigin (LastAppliedBlock crypto)
lab
             , Text
"currentBlockNo" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text -> Value
String (Text -> Value) -> (Word64 -> Text) -> Word64 -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Text
forall a. Show a => a -> Text
textShow (Word64 -> Value) -> Word64 -> Value
forall a b. (a -> b) -> a -> b
$ BlockNo -> Word64
unBlockNo BlockNo
currentBlockNo)
             ]
  toObject TracingVerbosity
_verb (WrongBlockSequencePrtclSeq PrevHash crypto
lastAppliedHash PrevHash crypto
currentHash) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongBlockSequence"
             , Text
"lastAppliedBlockHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (PrevHash crypto -> Text
forall a. Show a => a -> Text
textShow PrevHash crypto
lastAppliedHash)
             , Text
"currentBlockHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (PrevHash crypto -> Text
forall a. Show a => a -> Text
textShow PrevHash crypto
currentHash)
             ]

instance ( ShelleyBasedEra era
         , ToObject (PredicateFailure (UTXO era))
         , ToObject (PredicateFailure (UTXOW era))
         ) => ToObject (BbodyPredicateFailure era) where
  toObject :: TracingVerbosity -> BbodyPredicateFailure era -> Object
toObject TracingVerbosity
_verb (WrongBlockBodySizeBBODY Int
actualBodySz Int
claimedBodySz) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongBlockBodySizeBBODY"
             , Text
"actualBlockBodySize" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
actualBodySz
             , Text
"claimedBlockBodySize" Text -> Int -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
claimedBodySz
             ]
  toObject TracingVerbosity
_verb (InvalidBodyHashBBODY HashBBody (Crypto era)
actualHash HashBBody (Crypto era)
claimedHash) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"InvalidBodyHashBBODY"
             , Text
"actualBodyHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= HashBBody (Crypto era) -> Text
forall a. Show a => a -> Text
textShow HashBBody (Crypto era)
actualHash
             , Text
"claimedBodyHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= HashBBody (Crypto era) -> Text
forall a. Show a => a -> Text
textShow HashBBody (Crypto era)
claimedHash
             ]
  toObject TracingVerbosity
verb (LedgersFailure PredicateFailure (LEDGERS era)
f) = TracingVerbosity -> LedgersPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (LEDGERS era)
LedgersPredicateFailure era
f


instance ( ShelleyBasedEra era
         , ToObject (PredicateFailure (UTXO era))
         , ToObject (PredicateFailure (UTXOW era))
         ) => ToObject (LedgersPredicateFailure era) where
  toObject :: TracingVerbosity -> LedgersPredicateFailure era -> Object
toObject TracingVerbosity
verb (LedgerFailure PredicateFailure (LEDGER era)
f) = TracingVerbosity -> LedgerPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (LEDGER era)
LedgerPredicateFailure era
f


instance ( ShelleyBasedEra era
         , ToObject (PredicateFailure (UTXO era))
         , ToObject (PredicateFailure (UTXOW era))
         ) => ToObject (LedgerPredicateFailure era) where
  toObject :: TracingVerbosity -> LedgerPredicateFailure era -> Object
toObject TracingVerbosity
verb (UtxowFailure PredicateFailure (UTXOW era)
f) = TracingVerbosity -> PredicateFailure (UTXOW era) -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (UTXOW era)
f
  toObject TracingVerbosity
verb (DelegsFailure PredicateFailure (DELEGS era)
f) = TracingVerbosity -> DelegsPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (DELEGS era)
DelegsPredicateFailure era
f


instance (ShelleyBasedEra era, ToObject (PredicateFailure (UTXO era)))
      => ToObject (UtxowPredicateFailure era) where
  toObject :: TracingVerbosity -> UtxowPredicateFailure era -> Object
toObject TracingVerbosity
_verb (InvalidWitnessesUTXOW [VKey 'Witness (Crypto era)]
wits) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"InvalidWitnessesUTXOW"
             , Text
"invalidWitnesses" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (VKey 'Witness (Crypto era) -> Text)
-> [VKey 'Witness (Crypto era)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map VKey 'Witness (Crypto era) -> Text
forall a. Show a => a -> Text
textShow [VKey 'Witness (Crypto era)]
wits
             ]
  toObject TracingVerbosity
_verb (MissingVKeyWitnessesUTXOW (WitHashes Set (KeyHash 'Witness (Crypto era))
wits)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MissingVKeyWitnessesUTXOW"
             , Text
"missingWitnesses" Text -> Set (KeyHash 'Witness (Crypto era)) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (KeyHash 'Witness (Crypto era))
wits
             ]
  toObject TracingVerbosity
_verb (MissingScriptWitnessesUTXOW Set (ScriptHash era)
missingScripts) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MissingScriptWitnessesUTXOW"
             , Text
"missingScripts" Text -> Set (ScriptHash era) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (ScriptHash era)
missingScripts
             ]
  toObject TracingVerbosity
_verb (ScriptWitnessNotValidatingUTXOW Set (ScriptHash era)
failedScripts) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ScriptWitnessNotValidatingUTXOW"
             , Text
"failedScripts" Text -> Set (ScriptHash era) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (ScriptHash era)
failedScripts
             ]
  toObject TracingVerbosity
verb (UtxoFailure PredicateFailure (UTXO era)
f) = TracingVerbosity -> PredicateFailure (UTXO era) -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (UTXO era)
f
  toObject TracingVerbosity
_verb (MIRInsufficientGenesisSigsUTXOW Set (KeyHash 'Witness (Crypto era))
genesisSigs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MIRInsufficientGenesisSigsUTXOW"
             , Text
"genesisSigs" Text -> Set (KeyHash 'Witness (Crypto era)) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (KeyHash 'Witness (Crypto era))
genesisSigs
             ]
  toObject TracingVerbosity
_verb (MissingTxBodyMetaDataHash MetaDataHash era
metaDataHash) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MissingTxBodyMetaDataHash"
             , Text
"metaDataHash" Text -> MetaDataHash era -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MetaDataHash era
metaDataHash
             ]
  toObject TracingVerbosity
_verb (MissingTxMetaData MetaDataHash era
txBodyMetaDataHash) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MissingTxMetaData"
             , Text
"txBodyMetaDataHash" Text -> MetaDataHash era -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MetaDataHash era
txBodyMetaDataHash
             ]
  toObject TracingVerbosity
_verb (ConflictingMetaDataHash MetaDataHash era
txBodyMetaDataHash MetaDataHash era
fullMetaDataHash) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ConflictingMetaDataHash"
             , Text
"txBodyMetaDataHash" Text -> MetaDataHash era -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MetaDataHash era
txBodyMetaDataHash
             , Text
"fullMetaDataHash" Text -> MetaDataHash era -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MetaDataHash era
fullMetaDataHash
             ]
  toObject TracingVerbosity
_verb UtxowPredicateFailure era
InvalidMetaData =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"InvalidMetaData"
             ]

-- TODO the equality will need to be removed when Mary is switched to the real
-- Mary era instead of just a copy of Shelley. 'renderValueNotConservedErr' will
-- need to be changed accordingly.
instance (ShelleyBasedEra era, Core.Value era ~ Coin)
      => ToObject (UtxoPredicateFailure era) where
  toObject :: TracingVerbosity -> UtxoPredicateFailure era -> Object
toObject TracingVerbosity
_verb (BadInputsUTxO Set (TxIn era)
badInputs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"BadInputsUTxO"
             , Text
"badInputs" Text -> Set (TxIn era) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (TxIn era)
badInputs
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (TxIn era) -> Value
forall era. Set (TxIn era) -> Value
renderBadInputsUTxOErr Set (TxIn era)
badInputs
             ]
  toObject TracingVerbosity
_verb (ExpiredUTxO SlotNo
ttl SlotNo
slot) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ExpiredUTxO"
             , Text
"ttl"  Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
ttl
             , Text
"slot" Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
slot ]
  toObject TracingVerbosity
_verb (MaxTxSizeUTxO Integer
txsize Integer
maxtxsize) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MaxTxSizeUTxO"
             , Text
"size" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
txsize
             , Text
"maxSize" Text -> Integer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer
maxtxsize ]
  -- TODO: Add the minimum allowed UTxO value to OutputTooSmallUTxO
  toObject TracingVerbosity
_verb (OutputTooSmallUTxO [TxOut era]
badOutputs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"OutputTooSmallUTxO"
             , Text
"outputs" Text -> [TxOut era] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [TxOut era]
badOutputs
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"The output is smaller than the allow minimum \
                                 \UTxO value defined in the protocol parameters"
             ]
  toObject TracingVerbosity
_verb (OutputBootAddrAttrsTooBig [TxOut era]
badOutputs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"OutputBootAddrAttrsTooBig"
             , Text
"outputs" Text -> [TxOut era] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [TxOut era]
badOutputs
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"The Byron address attributes are too big"
             ]
  toObject TracingVerbosity
_verb UtxoPredicateFailure era
InputSetEmptyUTxO =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"InputSetEmptyUTxO" ]
  toObject TracingVerbosity
_verb (FeeTooSmallUTxO Coin
minfee Coin
txfee) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"FeeTooSmallUTxO"
             , Text
"minimum" Text -> Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
minfee
             , Text
"fee" Text -> Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
txfee ]
  toObject TracingVerbosity
_verb (ValueNotConservedUTxO Delta (Value era)
consumed Delta (Value era)
produced) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ValueNotConservedUTxO"
             , Text
"consumed" Text -> DeltaCoin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DeltaCoin
Delta (Value era)
consumed
             , Text
"produced" Text -> DeltaCoin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DeltaCoin
Delta (Value era)
produced
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DeltaCoin -> DeltaCoin -> Value
renderValueNotConservedErr DeltaCoin
Delta (Value era)
consumed DeltaCoin
Delta (Value era)
produced
             ]
  toObject TracingVerbosity
verb (UpdateFailure PredicateFailure (PPUP era)
f) = TracingVerbosity -> PpupPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (PPUP era)
PpupPredicateFailure era
f

  toObject TracingVerbosity
_verb (WrongNetwork Network
network Set (Addr era)
addrs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongNetwork"
             , Text
"network" Text -> Network -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network
network
             , Text
"addrs"   Text -> Set (Addr era) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (Addr era)
addrs
             ]
  toObject TracingVerbosity
_verb (WrongNetworkWithdrawal Network
network Set (RewardAcnt era)
addrs) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongNetworkWithdrawal"
             , Text
"network" Text -> Network -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network
network
             , Text
"addrs"   Text -> Set (RewardAcnt era) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (RewardAcnt era)
addrs
             ]

renderBadInputsUTxOErr ::  Set (TxIn era) -> Value
renderBadInputsUTxOErr :: Set (TxIn era) -> Value
renderBadInputsUTxOErr Set (TxIn era)
txIns
  | Set (TxIn era) -> Bool
forall a. Set a -> Bool
Set.null Set (TxIn era)
txIns = Text -> Value
String Text
"The transaction contains no inputs."
  | Bool
otherwise = Text -> Value
String Text
"The transaction contains inputs that do not exist in the UTxO set."

renderValueNotConservedErr :: DeltaCoin -> DeltaCoin -> Value
renderValueNotConservedErr :: DeltaCoin -> DeltaCoin -> Value
renderValueNotConservedErr DeltaCoin
consumed DeltaCoin
produced
  | DeltaCoin
consumed DeltaCoin -> DeltaCoin -> Bool
forall a. Ord a => a -> a -> Bool
> DeltaCoin
produced = Text -> Value
String Text
"This transaction has consumed more Lovelace than it has produced."
  | DeltaCoin
consumed DeltaCoin -> DeltaCoin -> Bool
forall a. Ord a => a -> a -> Bool
< DeltaCoin
produced = Text -> Value
String Text
"This transaction has produced more Lovelace than it has consumed."
  | Bool
otherwise = Text -> Value
String Text
"Impossible: Somehow this error has occurred in spite of the transaction being balanced."

instance ToObject (PpupPredicateFailure era) where
  toObject :: TracingVerbosity -> PpupPredicateFailure era -> Object
toObject TracingVerbosity
_verb (NonGenesisUpdatePPUP Set (KeyHash 'Genesis (Crypto era))
proposalKeys Set (KeyHash 'Genesis (Crypto era))
genesisKeys) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"NonGenesisUpdatePPUP"
             , Text
"keys" Text -> Set (KeyHash 'Genesis (Crypto era)) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set (KeyHash 'Genesis (Crypto era))
proposalKeys Set (KeyHash 'Genesis (Crypto era))
-> Set (KeyHash 'Genesis (Crypto era))
-> Set (KeyHash 'Genesis (Crypto era))
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set (KeyHash 'Genesis (Crypto era))
genesisKeys ]
  toObject TracingVerbosity
_verb (PPUpdateWrongEpoch EpochNo
currEpoch EpochNo
intendedEpoch VotingPeriod
votingPeriod) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"PPUpdateWrongEpoch"
             , Text
"currentEpoch" Text -> EpochNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EpochNo
currEpoch
             , Text
"intendedEpoch" Text -> EpochNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EpochNo
intendedEpoch
             , Text
"votingPeriod"  Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (VotingPeriod -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show VotingPeriod
votingPeriod)
             ]
  toObject TracingVerbosity
_verb (PVCannotFollowPPUP ProtVer
badPv) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"PVCannotFollowPPUP"
             , Text
"badProtocolVersion" Text -> ProtVer -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProtVer
badPv
             ]


instance ShelleyBasedEra era => ToObject (DelegsPredicateFailure era) where
  toObject :: TracingVerbosity -> DelegsPredicateFailure era -> Object
toObject TracingVerbosity
_verb (DelegateeNotRegisteredDELEG KeyHash 'StakePool (Crypto era)
targetPool) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"DelegateeNotRegisteredDELEG"
             , Text
"targetPool" Text -> KeyHash 'StakePool (Crypto era) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KeyHash 'StakePool (Crypto era)
targetPool
             ]
  toObject TracingVerbosity
_verb (WithdrawalsNotInRewardsDELEGS Map (RewardAcnt era) Coin
incorrectWithdrawals) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WithdrawalsNotInRewardsDELEGS"
             , Text
"incorrectWithdrawals" Text -> Map (RewardAcnt era) Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map (RewardAcnt era) Coin
incorrectWithdrawals
             ]
  toObject TracingVerbosity
verb (DelplFailure PredicateFailure (DELPL era)
f) = TracingVerbosity -> DelplPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (DELPL era)
DelplPredicateFailure era
f


instance ToObject (DelplPredicateFailure era) where
  toObject :: TracingVerbosity -> DelplPredicateFailure era -> Object
toObject TracingVerbosity
verb (PoolFailure PredicateFailure (POOL era)
f) = TracingVerbosity -> PoolPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (POOL era)
PoolPredicateFailure era
f
  toObject TracingVerbosity
verb (DelegFailure PredicateFailure (DELEG era)
f) = TracingVerbosity -> DelegPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (DELEG era)
DelegPredicateFailure era
f

instance ToObject (DelegPredicateFailure era) where
  toObject :: TracingVerbosity -> DelegPredicateFailure era -> Object
toObject TracingVerbosity
_verb (StakeKeyAlreadyRegisteredDELEG Credential 'Staking era
alreadyRegistered) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StakeKeyAlreadyRegisteredDELEG"
             , Text
"credential" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Credential 'Staking era -> Text
forall a. Show a => a -> Text
textShow Credential 'Staking era
alreadyRegistered)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Staking credential already registered"
             ]
  toObject TracingVerbosity
_verb (StakeKeyInRewardsDELEG Credential 'Staking era
alreadyRegistered) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StakeKeyInRewardsDELEG"
             , Text
"credential" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Credential 'Staking era -> Text
forall a. Show a => a -> Text
textShow Credential 'Staking era
alreadyRegistered)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Staking credential registered in rewards map"
             ]
  toObject TracingVerbosity
_verb (StakeKeyNotRegisteredDELEG Credential 'Staking era
notRegistered) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StakeKeyNotRegisteredDELEG"
             , Text
"credential" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Credential 'Staking era -> Text
forall a. Show a => a -> Text
textShow Credential 'Staking era
notRegistered)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Staking credential not registered"
             ]
  toObject TracingVerbosity
_verb (StakeKeyNonZeroAccountBalanceDELEG Maybe Coin
remBalance) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StakeKeyNonZeroAccountBalanceDELEG"
             , Text
"remainingBalance" Text -> Maybe Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Coin
remBalance
             ]
  toObject TracingVerbosity
_verb (StakeDelegationImpossibleDELEG Credential 'Staking era
unregistered) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StakeDelegationImpossibleDELEG"
             , Text
"credential" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Credential 'Staking era -> Text
forall a. Show a => a -> Text
textShow Credential 'Staking era
unregistered)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Cannot delegate this stake credential because it is not registered"
             ]
  toObject TracingVerbosity
_verb DelegPredicateFailure era
WrongCertificateTypeDELEG =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongCertificateTypeDELEG" ]
  toObject TracingVerbosity
_verb (GenesisKeyNotInMappingDELEG (KeyHash Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
genesisKeyHash)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"GenesisKeyNotInMappingDELEG"
             , Text
"unknownKeyHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
-> Text
forall a. Show a => a -> Text
textShow Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
genesisKeyHash)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"This genesis key is not in the delegation mapping"
             ]
  toObject TracingVerbosity
_verb (DuplicateGenesisDelegateDELEG (KeyHash Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
genesisKeyHash)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"DuplicateGenesisDelegateDELEG"
             , Text
"duplicateKeyHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
-> Text
forall a. Show a => a -> Text
textShow Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
genesisKeyHash)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"This genesis key has already been delegated to"
             ]
  toObject TracingVerbosity
_verb (InsufficientForInstantaneousRewardsDELEG MIRPot
mirpot Coin
neededMirAmount Coin
reserves) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"InsufficientForInstantaneousRewardsDELEG"
             , Text
"pot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (case MIRPot
mirpot of
                                  MIRPot
ReservesMIR -> Text
"Reserves"
                                  MIRPot
TreasuryMIR -> Text
"Treasury")
             , Text
"neededAmount" Text -> Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
neededMirAmount
             , Text
"reserves" Text -> Coin -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Coin
reserves
             ]
  toObject TracingVerbosity
_verb (MIRCertificateTooLateinEpochDELEG SlotNo
currSlot SlotNo
boundSlotNo) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"MIRCertificateTooLateinEpochDELEG"
             , Text
"currentSlotNo" Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
currSlot
             , Text
"mustBeSubmittedBeforeSlotNo" Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
boundSlotNo
             ]
  toObject TracingVerbosity
_verb (DuplicateGenesisVRFDELEG Hash (Crypto era) (VerKeyVRF (Crypto era))
vrfKeyHash) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"DuplicateGenesisVRFDELEG"
             , Text
"keyHash" Text -> Hash (Crypto era) (VerKeyVRF (Crypto era)) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash (Crypto era) (VerKeyVRF (Crypto era))
vrfKeyHash
             ]


instance ToObject (PoolPredicateFailure era) where
  toObject :: TracingVerbosity -> PoolPredicateFailure era -> Object
toObject TracingVerbosity
_verb (StakePoolNotRegisteredOnKeyPOOL (KeyHash Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
unregStakePool)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StakePoolNotRegisteredOnKeyPOOL"
             , Text
"unregisteredKeyHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
-> Text
forall a. Show a => a -> Text
textShow Hash (ADDRHASH (Crypto era)) (VerKeyDSIGN (DSIGN (Crypto era)))
unregStakePool)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"This stake pool key hash is unregistered"
             ]
  toObject TracingVerbosity
_verb (StakePoolRetirementWrongEpochPOOL Word64
currentEpoch Word64
intendedRetireEpoch Word64
maxRetireEpoch) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StakePoolRetirementWrongEpochPOOL"
             , Text
"currentEpoch" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
currentEpoch)
             , Text
"intendedRetirementEpoch" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
intendedRetireEpoch)
             , Text
"maxEpochForRetirement" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
maxRetireEpoch)
             ]
  toObject TracingVerbosity
_verb (StakePoolCostTooLowPOOL Coin
certCost Coin
protCost) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"StakePoolCostTooLowPOOL"
             , Text
"certificateCost" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Coin -> Text
forall a. Show a => a -> Text
textShow Coin
certCost)
             , Text
"protocolParCost" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Coin -> Text
forall a. Show a => a -> Text
textShow Coin
protCost)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"The stake pool cost is too low"
             ]


-- Apparently this should never happen according to the Shelley exec spec
  toObject TracingVerbosity
_verb (WrongCertificateTypePOOL Word8
index) =
    case Word8
index of
      Word8
0 -> [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongCertificateTypePOOL"
                    , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Wrong certificate type: Delegation certificate"
                    ]
      Word8
1 -> [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongCertificateTypePOOL"
                    , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Wrong certificate type: MIR certificate"
                    ]
      Word8
2 -> [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongCertificateTypePOOL"
                    , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Wrong certificate type: Genesis certificate"
                    ]
      Word8
k -> [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongCertificateTypePOOL"
                    , Text
"certificateType" Text -> Word8 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word8
k
                    , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Wrong certificate type: Unknown certificate type"
                    ]


instance ToObject (TickPredicateFailure era) where
  toObject :: TracingVerbosity -> TickPredicateFailure era -> Object
toObject TracingVerbosity
verb (NewEpochFailure PredicateFailure (NEWEPOCH era)
f) = TracingVerbosity -> NewEpochPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (NEWEPOCH era)
NewEpochPredicateFailure era
f
  toObject TracingVerbosity
verb (RupdFailure PredicateFailure (RUPD era)
f) = TracingVerbosity -> RupdPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (RUPD era)
RupdPredicateFailure era
f

instance ToObject TicknPredicateFailure where
  toObject :: TracingVerbosity -> TicknPredicateFailure -> Object
toObject TracingVerbosity
_verb TicknPredicateFailure
x = case TicknPredicateFailure
x of {} -- no constructors

instance ToObject (NewEpochPredicateFailure era) where
  toObject :: TracingVerbosity -> NewEpochPredicateFailure era -> Object
toObject TracingVerbosity
verb (EpochFailure PredicateFailure (EPOCH era)
f) = TracingVerbosity -> EpochPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (EPOCH era)
EpochPredicateFailure era
f
  toObject TracingVerbosity
verb (MirFailure PredicateFailure (MIR era)
f) = TracingVerbosity -> MirPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (MIR era)
MirPredicateFailure era
f
  toObject TracingVerbosity
_verb (CorruptRewardUpdate RewardUpdate era
update) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"CorruptRewardUpdate"
             , Text
"update" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (RewardUpdate era -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show RewardUpdate era
update) ]


instance ToObject (EpochPredicateFailure era) where
  toObject :: TracingVerbosity -> EpochPredicateFailure era -> Object
toObject TracingVerbosity
verb (PoolReapFailure PredicateFailure (POOLREAP era)
f) = TracingVerbosity -> PoolreapPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (POOLREAP era)
PoolreapPredicateFailure era
f
  toObject TracingVerbosity
verb (SnapFailure PredicateFailure (SNAP era)
f) = TracingVerbosity -> SnapPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (SNAP era)
SnapPredicateFailure era
f
  toObject TracingVerbosity
verb (NewPpFailure PredicateFailure (NEWPP era)
f) = TracingVerbosity -> NewppPredicateFailure era -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (NEWPP era)
NewppPredicateFailure era
f


instance ToObject (PoolreapPredicateFailure era) where
  toObject :: TracingVerbosity -> PoolreapPredicateFailure era -> Object
toObject TracingVerbosity
_verb PoolreapPredicateFailure era
x = case PoolreapPredicateFailure era
x of {} -- no constructors


instance ToObject (SnapPredicateFailure era) where
  toObject :: TracingVerbosity -> SnapPredicateFailure era -> Object
toObject TracingVerbosity
_verb SnapPredicateFailure era
x = case SnapPredicateFailure era
x of {} -- no constructors

-- TODO: Need to elaborate more on this error
instance ToObject (NewppPredicateFailure era) where
  toObject :: TracingVerbosity -> NewppPredicateFailure era -> Object
toObject TracingVerbosity
_verb (UnexpectedDepositPot Coin
outstandingDeposits Coin
depositPot) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"UnexpectedDepositPot"
             , Text
"outstandingDeposits" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Coin -> Text
forall a. Show a => a -> Text
textShow Coin
outstandingDeposits)
             , Text
"depositPot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Coin -> Text
forall a. Show a => a -> Text
textShow Coin
depositPot)
             ]


instance ToObject (MirPredicateFailure era) where
  toObject :: TracingVerbosity -> MirPredicateFailure era -> Object
toObject TracingVerbosity
_verb MirPredicateFailure era
x = case MirPredicateFailure era
x of {} -- no constructors


instance ToObject (RupdPredicateFailure era) where
  toObject :: TracingVerbosity -> RupdPredicateFailure era -> Object
toObject TracingVerbosity
_verb RupdPredicateFailure era
x = case RupdPredicateFailure era
x of {} -- no constructors


instance Core.Crypto crypto => ToObject (PrtclPredicateFailure crypto) where
  toObject :: TracingVerbosity -> PrtclPredicateFailure crypto -> Object
toObject  TracingVerbosity
verb (OverlayFailure PredicateFailure (OVERLAY crypto)
f) = TracingVerbosity -> OverlayPredicateFailure crypto -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (OVERLAY crypto)
OverlayPredicateFailure crypto
f
  toObject  TracingVerbosity
verb (UpdnFailure PredicateFailure (UPDN crypto)
f) = TracingVerbosity -> UpdnPredicateFailure crypto -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (UPDN crypto)
UpdnPredicateFailure crypto
f


instance Core.Crypto crypto => ToObject (OverlayPredicateFailure crypto) where
  toObject :: TracingVerbosity -> OverlayPredicateFailure crypto -> Object
toObject TracingVerbosity
_verb (UnknownGenesisKeyOVERLAY (KeyHash Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
genKeyHash)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"UnknownGenesisKeyOVERLAY"
             , Text
"unknownKeyHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)) -> Text
forall a. Show a => a -> Text
textShow Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
genKeyHash)
             ]
  toObject TracingVerbosity
_verb (VRFKeyBadLeaderValue Nonce
seedNonce (SlotNo Word64
currSlotNo) Nonce
prevHashNonce CertifiedVRF (VRF crypto) Nonce
leaderElecVal) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"VRFKeyBadLeaderValueOVERLAY"
             , Text
"seedNonce" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Nonce -> Text
forall a. Show a => a -> Text
textShow Nonce
seedNonce)
             , Text
"currentSlot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
currSlotNo)
             , Text
"previousHashAsNonce" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Nonce -> Text
forall a. Show a => a -> Text
textShow Nonce
prevHashNonce)
             , Text
"leaderElectionValue" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (CertifiedVRF (VRF crypto) Nonce -> Text
forall a. Show a => a -> Text
textShow CertifiedVRF (VRF crypto) Nonce
leaderElecVal)
             ]
  toObject TracingVerbosity
_verb (VRFKeyBadNonce Nonce
seedNonce (SlotNo Word64
currSlotNo) Nonce
prevHashNonce CertifiedVRF (VRF crypto) Nonce
blockNonce) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"VRFKeyBadNonceOVERLAY"
             , Text
"seedNonce" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Nonce -> Text
forall a. Show a => a -> Text
textShow Nonce
seedNonce)
             , Text
"currentSlot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
currSlotNo)
             , Text
"previousHashAsNonce" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Nonce -> Text
forall a. Show a => a -> Text
textShow Nonce
prevHashNonce)
             , Text
"blockNonce" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (CertifiedVRF (VRF crypto) Nonce -> Text
forall a. Show a => a -> Text
textShow CertifiedVRF (VRF crypto) Nonce
blockNonce)
             ]
  toObject TracingVerbosity
_verb (VRFKeyWrongVRFKey KeyHash 'StakePool crypto
issuerHash Hash crypto (VerKeyVRF crypto)
regVRFKeyHash Hash crypto (VerKeyVRF crypto)
unregVRFKeyHash) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"VRFKeyWrongVRFKeyOVERLAY"
             , Text
"poolHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KeyHash 'StakePool crypto -> Text
forall a. Show a => a -> Text
textShow KeyHash 'StakePool crypto
issuerHash
             , Text
"registeredVRFKeHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash crypto (VerKeyVRF crypto) -> Text
forall a. Show a => a -> Text
textShow Hash crypto (VerKeyVRF crypto)
regVRFKeyHash
             , Text
"unregisteredVRFKeyHash" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash crypto (VerKeyVRF crypto) -> Text
forall a. Show a => a -> Text
textShow Hash crypto (VerKeyVRF crypto)
unregVRFKeyHash
             ]
  --TODO: Pipe slot number with VRFKeyUnknown
  toObject TracingVerbosity
_verb (VRFKeyUnknown (KeyHash Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
kHash)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"VRFKeyUnknownOVERLAY"
             , Text
"keyHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)) -> Text
forall a. Show a => a -> Text
textShow Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
kHash)
             ]
  toObject TracingVerbosity
_verb (VRFLeaderValueTooBig OutputVRF (VRF crypto)
leadElecVal Rational
weightOfDelegPool ActiveSlotCoeff
actSlotCoefff) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"VRFLeaderValueTooBigOVERLAY"
             , Text
"leaderElectionValue" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (OutputVRF (VRF crypto) -> Text
forall a. Show a => a -> Text
textShow OutputVRF (VRF crypto)
leadElecVal)
             , Text
"delegationPoolWeight" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Rational -> Text
forall a. Show a => a -> Text
textShow Rational
weightOfDelegPool)
             , Text
"activeSlotCoefficient" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ActiveSlotCoeff -> Text
forall a. Show a => a -> Text
textShow ActiveSlotCoeff
actSlotCoefff)
             ]
  toObject TracingVerbosity
_verb (NotActiveSlotOVERLAY SlotNo
notActiveSlotNo) =
    -- TODO: Elaborate on NotActiveSlot error
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"NotActiveSlotOVERLAY"
             , Text
"slot" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (SlotNo -> Text
forall a. Show a => a -> Text
textShow SlotNo
notActiveSlotNo)
             ]
  toObject TracingVerbosity
_verb (WrongGenesisColdKeyOVERLAY KeyHash 'BlockIssuer crypto
actual KeyHash 'GenesisDelegate crypto
expected) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongGenesisColdKeyOVERLAY"
             , Text
"actual" Text -> KeyHash 'BlockIssuer crypto -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KeyHash 'BlockIssuer crypto
actual
             , Text
"expected" Text -> KeyHash 'GenesisDelegate crypto -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KeyHash 'GenesisDelegate crypto
expected ]
  toObject TracingVerbosity
_verb (WrongGenesisVRFKeyOVERLAY KeyHash 'BlockIssuer crypto
issuer Hash crypto (VerKeyVRF crypto)
actual Hash crypto (VerKeyVRF crypto)
expected) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"WrongGenesisVRFKeyOVERLAY"
             , Text
"issuer" Text -> KeyHash 'BlockIssuer crypto -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KeyHash 'BlockIssuer crypto
issuer
             , Text
"actual" Text -> Hash crypto (VerKeyVRF crypto) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash crypto (VerKeyVRF crypto)
actual
             , Text
"expected" Text -> Hash crypto (VerKeyVRF crypto) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash crypto (VerKeyVRF crypto)
expected ]
  toObject TracingVerbosity
verb (OcertFailure PredicateFailure (OCERT crypto)
f) = TracingVerbosity -> OcertPredicateFailure crypto -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb PredicateFailure (OCERT crypto)
OcertPredicateFailure crypto
f


instance ToObject (OcertPredicateFailure crypto) where
  toObject :: TracingVerbosity -> OcertPredicateFailure crypto -> Object
toObject TracingVerbosity
_verb (KESBeforeStartOCERT (KESPeriod KESEvolution
oCertstart) (KESPeriod KESEvolution
current)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"KESBeforeStartOCERT"
             , Text
"opCertKESStartPeriod" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (KESEvolution -> Text
forall a. Show a => a -> Text
textShow KESEvolution
oCertstart)
             , Text
"currentKESPeriod" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (KESEvolution -> Text
forall a. Show a => a -> Text
textShow KESEvolution
current)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"Your operational certificate's KES start period \
                                 \is before the KES current period."
             ]
  toObject TracingVerbosity
_verb (KESAfterEndOCERT (KESPeriod KESEvolution
current) (KESPeriod KESEvolution
oCertstart) Word64
maxKESEvolutions) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"KESAfterEndOCERT"
             , Text
"currentKESPeriod" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (KESEvolution -> Text
forall a. Show a => a -> Text
textShow KESEvolution
current)
             , Text
"opCertKESStartPeriod" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (KESEvolution -> Text
forall a. Show a => a -> Text
textShow KESEvolution
oCertstart)
             , Text
"maxKESEvolutions" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String  (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
maxKESEvolutions)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"The operational certificate's KES start period is \
                                 \greater than the max number of KES + the KES current period"
             ]
  toObject TracingVerbosity
_verb (CounterTooSmallOCERT Word64
lastKEScounterUsed Word64
currentKESCounter) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"CounterTooSmallOCert"
             , Text
"currentKESCounter" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
currentKESCounter)
             , Text
"lastKESCounter" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
lastKEScounterUsed)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"The operational certificate's last KES counter is greater \
                                 \than the current KES counter."
             ]
  toObject TracingVerbosity
_verb (InvalidSignatureOCERT Word64
oCertCounter KESPeriod
oCertKESStartPeriod) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"InvalidSignatureOCERT"
             , Text
"opCertKESStartPeriod" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (KESPeriod -> Text
forall a. Show a => a -> Text
textShow KESPeriod
oCertKESStartPeriod)
             , Text
"opCertCounter" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
oCertCounter)
             ]
  toObject TracingVerbosity
_verb (InvalidKesSignatureOCERT KESEvolution
currKESPeriod KESEvolution
startKESPeriod KESEvolution
expectedKESEvolutions String
err) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"InvalidKesSignatureOCERT"
             , Text
"opCertKESStartPeriod" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (KESEvolution -> Text
forall a. Show a => a -> Text
textShow KESEvolution
startKESPeriod)
             , Text
"opCertKESCurrentPeriod" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (KESEvolution -> Text
forall a. Show a => a -> Text
textShow KESEvolution
currKESPeriod)
             , Text
"opCertExpectedKESEvolutions" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (KESEvolution -> Text
forall a. Show a => a -> Text
textShow KESEvolution
expectedKESEvolutions)
             , Text
"error" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
err ]
  toObject TracingVerbosity
_verb (NoCounterForKeyHashOCERT (KeyHash Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
stakePoolKeyHash)) =
    [(Text, Value)] -> Object
forall a. ToObject a => [(Text, a)] -> HashMap Text a
mkObject [ Text
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"NoCounterForKeyHashOCERT"
             , Text
"stakePoolKeyHash" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)) -> Text
forall a. Show a => a -> Text
textShow Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
stakePoolKeyHash)
             , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"A counter was not found for this stake pool key hash"
             ]


instance ToObject (UpdnPredicateFailure crypto) where
  toObject :: TracingVerbosity -> UpdnPredicateFailure crypto -> Object
toObject TracingVerbosity
_verb UpdnPredicateFailure crypto
x = case UpdnPredicateFailure crypto
x of {} -- no constructors

--------------------------------------------------------------------------------
-- Helper functions
--------------------------------------------------------------------------------

textShow :: Show a => a -> Text
textShow :: a -> Text
textShow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a b. (Show a, ConvertText String b) => a -> b
show

showLastAppBlockNo :: WithOrigin (LastAppliedBlock crypto) -> Text
showLastAppBlockNo :: WithOrigin (LastAppliedBlock crypto) -> Text
showLastAppBlockNo WithOrigin (LastAppliedBlock crypto)
wOblk =  case WithOrigin (LastAppliedBlock crypto)
-> Maybe (LastAppliedBlock crypto)
forall t. WithOrigin t -> Maybe t
withOriginToMaybe WithOrigin (LastAppliedBlock crypto)
wOblk of
                     Maybe (LastAppliedBlock crypto)
Nothing -> Text
"Genesis Block"
                     Just LastAppliedBlock crypto
blk -> Word64 -> Text
forall a. Show a => a -> Text
textShow (Word64 -> Text) -> (BlockNo -> Word64) -> BlockNo -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockNo -> Word64
unBlockNo (BlockNo -> Text) -> BlockNo -> Text
forall a b. (a -> b) -> a -> b
$ LastAppliedBlock crypto -> BlockNo
forall crypto. LastAppliedBlock crypto -> BlockNo
labBlockNo LastAppliedBlock crypto
blk

-- Common to cardano-cli

deriving newtype instance ShelleyBasedEra era => ToJSON (MetaDataHash era)

deriving instance ShelleyBasedEra era => ToJSON (TxIn era)
deriving newtype instance ToJSON (TxId era)
deriving newtype instance ToJSON DeltaCoin
instance ShelleyBasedEra era => ToJSONKey (TxIn era) where
  toJSONKey :: ToJSONKeyFunction (TxIn era)
toJSONKey = (TxIn era -> Text)
-> (TxIn era -> Encoding' Text) -> ToJSONKeyFunction (TxIn era)
forall a.
(a -> Text) -> (a -> Encoding' Text) -> ToJSONKeyFunction a
ToJSONKeyText TxIn era -> Text
forall era. ShelleyBasedEra era => TxIn era -> Text
txInToText (Text -> Encoding' Text
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding' Text)
-> (TxIn era -> Text) -> TxIn era -> Encoding' Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxIn era -> Text
forall era. ShelleyBasedEra era => TxIn era -> Text
txInToText)

txInToText :: ShelleyBasedEra era => TxIn era -> Text
txInToText :: TxIn era -> Text
txInToText (TxIn (TxId Hash (Crypto era) EraIndependentTxBody
txidHash) Natural
ix) =
  Hash (Crypto era) EraIndependentTxBody -> Text
forall crypto a. Hash crypto a -> Text
hashToText Hash (Crypto era) EraIndependentTxBody
txidHash
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"#"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Natural -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Natural
ix)

instance (ShelleyBasedEra era, ToJSON (Core.Value era)) => ToJSON (TxOut era) where
  toJSON :: TxOut era -> Value
toJSON (TxOut Addr era
addr Value era
amount) =
    [(Text, Value)] -> Value
Aeson.object
      [ Text
"address" Text -> Addr era -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Addr era
addr
      , Text
"amount" Text -> Value era -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value era
amount
      ]

hashToText :: Crypto.Hash crypto a -> Text
hashToText :: Hash crypto a -> Text
hashToText = ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (Hash crypto a -> ByteString) -> Hash crypto a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Hash crypto a -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytesAsHex