{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans  #-}

module Bcc.Tracing.OrphanInstances.Cole () where

import           Bcc.Prelude

import           Data.Aeson (Value (..))
import qualified Data.Set as Set
import qualified Data.Text as Text

import           Bcc.Tracing.OrphanInstances.Common
import           Bcc.Tracing.OrphanInstances.Consensus ()

import           Shardagnostic.Consensus.Block (Header)
import           Shardagnostic.Network.Block (blockHash, blockNo, blockSlot)

import           Shardagnostic.Consensus.Cole.Ledger (ColeBlock (..),
                   ColeOtherHeaderEnvelopeError (..), TxId (..), coleHeaderRaw)
import           Shardagnostic.Consensus.Cole.Ledger.Inspect (ColeLedgerUpdate (..),
                   ProtocolUpdate (..), UpdateState (..))
import           Shardagnostic.Consensus.Ledger.SupportsMempool (GenTx, txId)
import           Shardagnostic.Consensus.Util.Condense (condense)

import           Bcc.Chain.Block (ABlockOrBoundaryHdr (..), AHeader (..),
                   ChainValidationError (..), delegationCertificate)
import           Bcc.Chain.Cole.API (ApplyMempoolPayloadErr (..))
import           Bcc.Chain.Delegation (delegateVK)
import           Bcc.Crypto.Signing (VerificationKey)

{- HLINT ignore "Use :" -}

--
-- | instances of @ToObject@
--
-- NOTE: this list is sorted by the unqualified name of the outermost type.

instance ToObject ApplyMempoolPayloadErr where
  toObject :: TracingVerbosity -> ApplyMempoolPayloadErr -> Object
toObject TracingVerbosity
_verb (MempoolTxErr UTxOValidationError
utxoValidationErr) =
    [(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
"MempoolTxErr"
      , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (UTxOValidationError -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show UTxOValidationError
utxoValidationErr)
      ]
  toObject TracingVerbosity
_verb (MempoolDlgErr Error
delegScheduleError) =
    [(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
"MempoolDlgErr"
      , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Error -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Error
delegScheduleError)
      ]
  toObject TracingVerbosity
_verb (MempoolUpdateProposalErr Error
iFaceErr) =
    [(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
"MempoolUpdateProposalErr"
      , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Error -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Error
iFaceErr)
      ]
  toObject TracingVerbosity
_verb (MempoolUpdateVoteErr Error
iFaceErrr) =
    [(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
"MempoolUpdateVoteErr"
      , Text
"error" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (Error -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Error
iFaceErrr)
      ]

instance ToObject ColeLedgerUpdate where
  toObject :: TracingVerbosity -> ColeLedgerUpdate -> Object
toObject TracingVerbosity
verb (ColeUpdatedProtocolUpdates [ProtocolUpdate]
protocolUpdates) =
    [(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
"ColeUpdatedProtocolUpdates"
      , Text
"protocolUpdates" Text -> [Object] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ProtocolUpdate -> Object) -> [ProtocolUpdate] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (TracingVerbosity -> ProtocolUpdate -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb) [ProtocolUpdate]
protocolUpdates
      ]

instance ToObject ProtocolUpdate where
  toObject :: TracingVerbosity -> ProtocolUpdate -> Object
toObject TracingVerbosity
verb (ProtocolUpdate ProtocolVersion
updateVersion UpdateState
updateState) =
    [(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
"ProtocolUpdate"
      , Text
"protocolUpdateVersion" Text -> ProtocolVersion -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ProtocolVersion
updateVersion
      , Text
"protocolUpdateState"   Text -> Object -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TracingVerbosity -> UpdateState -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
verb UpdateState
updateState
      ]

instance ToObject UpdateState where
  toObject :: TracingVerbosity -> UpdateState -> Object
toObject TracingVerbosity
_verb UpdateState
updateState = case UpdateState
updateState of
      UpdateRegistered 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
"UpdateRegistered"
          , Text
"slot" Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
slot
          ]
      UpdateActive Set KeyHash
votes ->
        [(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
"UpdateActive"
          , Text
"votes" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (KeyHash -> Text) -> [KeyHash] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (String -> Text
Text.pack (String -> Text) -> (KeyHash -> String) -> KeyHash -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. KeyHash -> String
forall a b. (Show a, ConvertText String b) => a -> b
show) (Set KeyHash -> [KeyHash]
forall a. Set a -> [a]
Set.toList Set KeyHash
votes)
          ]
      UpdateConfirmed 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
"UpdateConfirmed"
          , Text
"slot" Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
slot
          ]
      UpdateStablyConfirmed Set KeyHash
endorsements ->
        [(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
"UpdateStablyConfirmed"
          , Text
"endorsements" Text -> [Text] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (KeyHash -> Text) -> [KeyHash] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (String -> Text
Text.pack (String -> Text) -> (KeyHash -> String) -> KeyHash -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. KeyHash -> String
forall a b. (Show a, ConvertText String b) => a -> b
show) (Set KeyHash -> [KeyHash]
forall a. Set a -> [a]
Set.toList Set KeyHash
endorsements)
          ]
      UpdateCandidate SlotNo
slot EpochNo
epoch ->
        [(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
"UpdateCandidate"
          , Text
"slot" Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
slot
          , Text
"epoch" Text -> EpochNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EpochNo
epoch
          ]
      UpdateStableCandidate EpochNo
transitionEpoch ->
        [(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
"UpdateStableCandidate"
          , Text
"transitionEpoch" Text -> EpochNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= EpochNo
transitionEpoch
          ]

instance ToObject (GenTx ColeBlock) where
  toObject :: TracingVerbosity -> GenTx ColeBlock -> Object
toObject TracingVerbosity
verb GenTx ColeBlock
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 ColeBlock) -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GenTx ColeBlock -> TxId (GenTx ColeBlock)
forall tx. HasTxId tx => tx -> TxId tx
txId GenTx ColeBlock
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 ColeBlock -> String
forall a. Condense a => a -> String
condense GenTx ColeBlock
tx | TracingVerbosity
verb TracingVerbosity -> TracingVerbosity -> Bool
forall a. Eq a => a -> a -> Bool
== TracingVerbosity
MaximalVerbosity ]


instance ToJSON (TxId (GenTx ColeBlock)) where
  toJSON :: TxId (GenTx ColeBlock) -> Value
toJSON (ColeTxId             i) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (TxId -> String
forall a. Condense a => a -> String
condense TxId
i)
  toJSON (ColeDlgId            i) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (CertificateId -> String
forall a. Condense a => a -> String
condense CertificateId
i)
  toJSON (ColeUpdateProposalId i) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (UpId -> String
forall a. Condense a => a -> String
condense UpId
i)
  toJSON (ColeUpdateVoteId     i) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (VoteId -> String
forall a. Condense a => a -> String
condense VoteId
i)


instance ToObject ChainValidationError where
  toObject :: TracingVerbosity -> ChainValidationError -> Object
toObject TracingVerbosity
_verb ChainValidationError
ChainValidationBoundaryTooLarge =
    [(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
"ChainValidationBoundaryTooLarge" ]
  toObject TracingVerbosity
_verb ChainValidationError
ChainValidationBlockAttributesTooLarge =
    [(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
"ChainValidationBlockAttributesTooLarge" ]
  toObject TracingVerbosity
_verb (ChainValidationBlockTooLarge Natural
_ Natural
_) =
    [(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
"ChainValidationBlockTooLarge" ]
  toObject TracingVerbosity
_verb ChainValidationError
ChainValidationHeaderAttributesTooLarge =
    [(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
"ChainValidationHeaderAttributesTooLarge" ]
  toObject TracingVerbosity
_verb (ChainValidationHeaderTooLarge Natural
_ Natural
_) =
    [(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
"ChainValidationHeaderTooLarge" ]
  toObject TracingVerbosity
_verb (ChainValidationDelegationPayloadError Text
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
err ]
  toObject TracingVerbosity
_verb (ChainValidationInvalidDelegation VerificationKey
_ VerificationKey
_) =
    [(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
"ChainValidationInvalidDelegation" ]
  toObject TracingVerbosity
_verb (ChainValidationGenesisHashMismatch GenesisHash
_ GenesisHash
_) =
    [(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
"ChainValidationGenesisHashMismatch" ]
  toObject TracingVerbosity
_verb (ChainValidationExpectedGenesisHash GenesisHash
_ HeaderHash
_) =
    [(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
"ChainValidationExpectedGenesisHash" ]
  toObject TracingVerbosity
_verb (ChainValidationExpectedHeaderHash HeaderHash
_ GenesisHash
_) =
    [(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
"ChainValidationExpectedHeaderHash" ]
  toObject TracingVerbosity
_verb (ChainValidationInvalidHash HeaderHash
_ HeaderHash
_) =
    [(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
"ChainValidationInvalidHash" ]
  toObject TracingVerbosity
_verb (ChainValidationMissingHash HeaderHash
_) =
    [(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
"ChainValidationMissingHash" ]
  toObject TracingVerbosity
_verb (ChainValidationUnexpectedGenesisHash HeaderHash
_) =
    [(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
"ChainValidationUnexpectedGenesisHash" ]
  toObject TracingVerbosity
_verb (ChainValidationInvalidSignature BlockSignature
_) =
    [(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
"ChainValidationInvalidSignature" ]
  toObject TracingVerbosity
_verb (ChainValidationDelegationSchedulingError 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
"ChainValidationDelegationSchedulingError" ]
  toObject TracingVerbosity
_verb (ChainValidationProtocolMagicMismatch ProtocolMagicId
_ ProtocolMagicId
_) =
    [(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
"ChainValidationProtocolMagicMismatch" ]
  toObject TracingVerbosity
_verb ChainValidationError
ChainValidationSignatureLight =
    [(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
"ChainValidationSignatureLight" ]
  toObject TracingVerbosity
_verb (ChainValidationTooManyDelegations VerificationKey
_) =
    [(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
"ChainValidationTooManyDelegations" ]
  toObject TracingVerbosity
_verb (ChainValidationUpdateError SlotNumber
_ 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
"ChainValidationUpdateError" ]
  toObject TracingVerbosity
_verb (ChainValidationUTxOValidationError UTxOValidationError
_) =
    [(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
"ChainValidationUTxOValidationError" ]
  toObject TracingVerbosity
_verb (ChainValidationProofValidationError ProofValidationError
_) =
    [(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
"ChainValidationProofValidationError" ]


instance ToObject (Header ColeBlock) where
  toObject :: TracingVerbosity -> Header ColeBlock -> Object
toObject TracingVerbosity
_verb Header ColeBlock
b =
    [(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
"kind" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"ColeBlock"
        , Text
"hash" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ColeHash -> String
forall a. Condense a => a -> String
condense (Header ColeBlock -> HeaderHash (Header ColeBlock)
forall b. HasHeader b => b -> HeaderHash b
blockHash Header ColeBlock
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 ColeBlock -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot Header ColeBlock
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 ColeBlock -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo Header ColeBlock
b)
        ] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<>
        case Header ColeBlock -> ABlockOrBoundaryHdr ByteString
coleHeaderRaw Header ColeBlock
b of
          ABOBBoundaryHdr{} -> []
          ABOBBlockHdr AHeader ByteString
h ->
            [ Text
"delegate" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= VerificationKey -> String
forall a. Condense a => a -> String
condense (AHeader ByteString -> VerificationKey
headerSignerVk AHeader ByteString
h) ]
   where
     headerSignerVk :: AHeader ByteString -> VerificationKey
     headerSignerVk :: AHeader ByteString -> VerificationKey
headerSignerVk =
       ACertificate ByteString -> VerificationKey
forall a. ACertificate a -> VerificationKey
delegateVK (ACertificate ByteString -> VerificationKey)
-> (AHeader ByteString -> ACertificate ByteString)
-> AHeader ByteString
-> VerificationKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlockSignature ByteString -> ACertificate ByteString
forall a. ABlockSignature a -> ACertificate a
delegationCertificate (ABlockSignature ByteString -> ACertificate ByteString)
-> (AHeader ByteString -> ABlockSignature ByteString)
-> AHeader ByteString
-> ACertificate ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AHeader ByteString -> ABlockSignature ByteString
forall a. AHeader a -> ABlockSignature a
headerSignature


instance ToObject ColeOtherHeaderEnvelopeError where
  toObject :: TracingVerbosity -> ColeOtherHeaderEnvelopeError -> Object
toObject TracingVerbosity
_verb (UnexpectedEBBInSlot 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
"UnexpectedEBBInSlot"
      , Text
"slot" Text -> SlotNo -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
slot
      ]