{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Network.Tracing.PeerSelection () where

import Data.Aeson
import Data.Text qualified as Text

import Cardano.Logging
import Cardano.Network.LedgerPeerConsensusInterface
import Cardano.Network.PeerSelection.ExtraRootPeers
import Cardano.Network.Tracing.Churn ()

instance LogFormatting (ToExtraTrace (ExtraPeers peeraddr)) where
  forMachine :: DetailLevel -> ToExtraTrace (ExtraPeers peeraddr) -> Object
forMachine DetailLevel
_dtal (TraceLedgerStateJudgementChanged LedgerStateJudgement
new) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LedgerStateJudgementChanged"
            , Key
"new"  Key -> Text -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String -> Text
Text.pack (LedgerStateJudgement -> String
forall a. Show a => a -> String
show LedgerStateJudgement
new) ]

  forMachine DetailLevel
_dtal (TraceUseBootstrapPeersChanged UseBootstrapPeers
ubp) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UseBootstrapPeersChanged"
            , Key
"useBootstrapPeers" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UseBootstrapPeers -> Value
forall a. ToJSON a => a -> Value
toJSON UseBootstrapPeers
ubp ]

  forHuman :: ToExtraTrace (ExtraPeers peeraddr) -> Text
forHuman = String -> Text
Text.pack (String -> Text)
-> (ToExtraTrace (ExtraPeers peeraddr) -> String)
-> ToExtraTrace (ExtraPeers peeraddr)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToExtraTrace (ExtraPeers peeraddr) -> String
forall a. Show a => a -> String
show


instance MetaTrace (ToExtraTrace (ExtraPeers peeraddr)) where
  namespaceFor :: ToExtraTrace (ExtraPeers peeraddr)
-> Namespace (ToExtraTrace (ExtraPeers peeraddr))
namespaceFor TraceLedgerStateJudgementChanged {} =
    [Text] -> [Text] -> Namespace (ToExtraTrace (ExtraPeers peeraddr))
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerStateJudgementChanged"]

  namespaceFor TraceUseBootstrapPeersChanged {} =
    [Text] -> [Text] -> Namespace (ToExtraTrace (ExtraPeers peeraddr))
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"UseBootstrapPeersChanged"]

  severityFor :: Namespace (ToExtraTrace (ExtraPeers peeraddr))
-> Maybe (ToExtraTrace (ExtraPeers peeraddr)) -> Maybe SeverityS
severityFor (Namespace [] [Text
"LedgerStateJudgementChanged"])
              (Just (TraceLedgerStateJudgementChanged LedgerStateJudgement
lsj))
                | LedgerStateJudgement
TooOld <- LedgerStateJudgement
lsj      = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning
                | LedgerStateJudgement
YoungEnough <- LedgerStateJudgement
lsj = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
  severityFor (Namespace [] [Text
"UseBootstrapPeersChanged"]) Maybe (ToExtraTrace (ExtraPeers peeraddr))
_ =
    SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice
  severityFor Namespace (ToExtraTrace (ExtraPeers peeraddr))
_ Maybe (ToExtraTrace (ExtraPeers peeraddr))
_ = Maybe SeverityS
forall a. Maybe a
Nothing

  documentFor :: Namespace (ToExtraTrace (ExtraPeers peeraddr)) -> Maybe Text
documentFor (Namespace [] [Text
"LedgerStateJudgementChanged"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Indicates whether the node is caught up or needs to sync"
  documentFor (Namespace [] [Text
"UseBootstrapPeersChanged"]) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Reacts to configuration changes related to bootstrap peers in the topology file"
  documentFor Namespace (ToExtraTrace (ExtraPeers peeraddr))
_ = Maybe Text
forall a. Maybe a
Nothing

  allNamespaces :: [Namespace (ToExtraTrace (ExtraPeers peeraddr))]
allNamespaces = [
    [Text] -> [Text] -> Namespace (ToExtraTrace (ExtraPeers peeraddr))
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"LedgerStateJudgementChanged"],
    [Text] -> [Text] -> Namespace (ToExtraTrace (ExtraPeers peeraddr))
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"UseBootstrapPeersChanged"]
    ]