{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE UndecidableInstances #-}

-- Orphan instances module for Cardano tracer.
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Network.Tracing.PeerSelection.Governor.DebugPeerSelection () where

import Cardano.Logging
import Data.Aeson (Value (String), (.=))
import Data.Text (pack)
import Ouroboros.Network.PeerSelection.Governor.Types

import Ouroboros.Network.Tracing.PeerSelection.Governor.Utils
           (peerSelectionTargetsToObject)

--------------------------------------------------------------------------------
-- DebugPeerSelection Tracer
--------------------------------------------------------------------------------

instance ( Show extraState
         , Show extraFlags
         , Show extraPeers
         , Show peeraddr
         , SupportsPeerSelectionState extraPeers peeraddr
         , LogFormatting (PeerSelectionCounters (ViewExtraPeers extraPeers))
         )
      => LogFormatting (DebugPeerSelection extraState extraFlags extraPeers peeraddr) where
  forMachine :: DetailLevel
-> DebugPeerSelection extraState extraFlags extraPeers peeraddr
-> Object
forMachine dtal :: DetailLevel
dtal@DetailLevel
DNormal (TraceGovernorState Time
blockedAt Maybe DiffTime
wakeupAfter
                   st :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st@PeerSelectionState { PeerSelectionTargets
targets :: PeerSelectionTargets
targets :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
targets }) =
    [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
"DebugPeerSelection"
            , Key
"blockedAt" 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 (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Time -> String
forall a. Show a => a -> String
show Time
blockedAt)
            , Key
"wakeupAfter" 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 (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe DiffTime -> String
forall a. Show a => a -> String
show Maybe DiffTime
wakeupAfter)
            , Key
"targets" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PeerSelectionTargets -> Value
peerSelectionTargetsToObject PeerSelectionTargets
targets
            , Key
"counters" Key -> Object -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DetailLevel
-> PeerSelectionCounters (ViewExtraPeers extraPeers) -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionCounters (ViewExtraPeers extraPeers)
forall extraPeers peeraddr extraState extraFlags peerconn.
SupportsPeerSelectionState extraPeers peeraddr =>
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionCounters (ViewExtraPeers extraPeers)
peerSelectionStateToCounters PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st)
            ]

  forMachine DetailLevel
_ (TraceGovernorState Time
blockedAt Maybe DiffTime
wakeupAfter PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
ev) =
    [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
"DebugPeerSelection"
            , Key
"blockedAt" 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 (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Time -> String
forall a. Show a => a -> String
show Time
blockedAt)
            , Key
"wakeupAfter" 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 (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe DiffTime -> String
forall a. Show a => a -> String
show Maybe DiffTime
wakeupAfter)
            , Key
"peerSelectionState" 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 (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> String
forall a. Show a => a -> String
show PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
ev)
            ]

  forHuman :: DebugPeerSelection extraState extraFlags extraPeers peeraddr
-> Text
forHuman = String -> Text
pack (String -> Text)
-> (DebugPeerSelection extraState extraFlags extraPeers peeraddr
    -> String)
-> DebugPeerSelection extraState extraFlags extraPeers peeraddr
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebugPeerSelection extraState extraFlags extraPeers peeraddr
-> String
forall a. Show a => a -> String
show

instance MetaTrace (DebugPeerSelection extraState extraFlags extraPeers peeraddr) where
    namespaceFor :: DebugPeerSelection extraState extraFlags extraPeers peeraddr
-> Namespace
     (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
namespaceFor TraceGovernorState {} = [Text]
-> [Text]
-> Namespace
     (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"GovernorState"]

    severityFor :: Namespace
  (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Maybe
     (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"GovernorState"]) Maybe
  (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor Namespace
  (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
_ Maybe
  (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
_                               = Maybe SeverityS
forall a. Maybe a
Nothing

    documentFor :: Namespace
  (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Maybe Text
documentFor (Namespace [Text]
_ [Text
"GovernorState"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Outbound peer selection internal state"
    documentFor Namespace
  (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
_                               = Maybe Text
forall a. Maybe a
Nothing

    allNamespaces :: [Namespace
   (DebugPeerSelection extraState extraFlags extraPeers peeraddr)]
allNamespaces = [
      [Text]
-> [Text]
-> Namespace
     (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"GovernorState"]
      ]