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

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

import Control.Exception (displayException)
import Data.Aeson (ToJSON (..), Value (String), (.=))
import Data.Text (pack)

import Cardano.Logging
import Ouroboros.Network.PeerSelection.PeerStateActions
           (PeerSelectionActionsTrace (..))
-- Needed for `instance ToJSON ConnectionId`.
import Ouroboros.Network.OrphanInstances ()

--------------------------------------------------------------------------------
-- PeerSelectionActions Tracer.
--------------------------------------------------------------------------------

-- TODO: Write PeerStatusChangeType ToJSON at ouroboros-network
-- For that an export is needed at ouroboros-network
instance (Show lAddr, Show peeraddr, ToJSON peeraddr)
      => LogFormatting (PeerSelectionActionsTrace peeraddr lAddr) where
  forMachine :: DetailLevel -> PeerSelectionActionsTrace peeraddr lAddr -> Object
forMachine DetailLevel
_dtal (PeerStatusChanged PeerStatusChangeType peeraddr
ps) =
    [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
"PeerStatusChanged"
             , Key
"peerStatusChangeType" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PeerStatusChangeType peeraddr -> String
forall a. Show a => a -> String
show PeerStatusChangeType peeraddr
ps
             ]
  forMachine DetailLevel
_dtal (PeerStatusChangeFailure PeerStatusChangeType peeraddr
ps FailureType lAddr
f) =
    [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
"PeerStatusChangeFailure"
             , Key
"peerStatusChangeType" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PeerStatusChangeType peeraddr -> String
forall a. Show a => a -> String
show PeerStatusChangeType peeraddr
ps
             , Key
"reason" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FailureType lAddr -> String
forall a. Show a => a -> String
show FailureType lAddr
f
             ]
  forMachine DetailLevel
_dtal (PeerMonitoringError ConnectionId peeraddr
connId SomeException
s) =
    [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
"PeerMonitoringError"
             , Key
"connectionId" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConnectionId peeraddr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId peeraddr
connId
             , Key
"reason" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SomeException -> String
forall a. Show a => a -> String
show SomeException
s
             ]
  forMachine DetailLevel
_dtal (PeerMonitoringResult ConnectionId peeraddr
connId Maybe (WithSomeProtocolTemperature FirstToFinishResult)
wf) =
    [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
"PeerMonitoringResult"
             , Key
"connectionId" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConnectionId peeraddr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId peeraddr
connId
             , Key
"withProtocolTemp" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe (WithSomeProtocolTemperature FirstToFinishResult) -> String
forall a. Show a => a -> String
show Maybe (WithSomeProtocolTemperature FirstToFinishResult)
wf
             ]
  forMachine DetailLevel
_dtal (AcquireConnectionError SomeException
exception) =
    [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
"AcquireConnectionError"
            , Key
"error" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
exception
            ]
  forMachine DetailLevel
_dtal (PeerHotDuration ConnectionId peeraddr
connId DiffTime
dt) =
    [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
"PeerHotDuration"
            , Key
"connectionId" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConnectionId peeraddr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId peeraddr
connId
            , Key
"time" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DiffTime -> String
forall a. Show a => a -> String
show DiffTime
dt]
  forHuman :: PeerSelectionActionsTrace peeraddr lAddr -> Text
forHuman = String -> Text
pack (String -> Text)
-> (PeerSelectionActionsTrace peeraddr lAddr -> String)
-> PeerSelectionActionsTrace peeraddr lAddr
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionActionsTrace peeraddr lAddr -> String
forall a. Show a => a -> String
show

instance MetaTrace (PeerSelectionActionsTrace peeraddr lAddr) where
    namespaceFor :: PeerSelectionActionsTrace peeraddr lAddr
-> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
namespaceFor PeerStatusChanged {} = [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StatusChanged"]
    namespaceFor PeerStatusChangeFailure {} = [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StatusChangeFailure"]
    namespaceFor PeerMonitoringError {} = [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MonitoringError"]
    namespaceFor PeerMonitoringResult {} = [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MonitoringResult"]
    namespaceFor AcquireConnectionError {} = [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ConnectionError"]
    namespaceFor PeerHotDuration {} = [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PeerHotDuration"]

    severityFor :: Namespace (PeerSelectionActionsTrace peeraddr lAddr)
-> Maybe (PeerSelectionActionsTrace peeraddr lAddr)
-> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"StatusChanged"]) Maybe (PeerSelectionActionsTrace peeraddr lAddr)
_       = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"StatusChangeFailure"]) Maybe (PeerSelectionActionsTrace peeraddr lAddr)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
    severityFor (Namespace [Text]
_ [Text
"MonitoringError"]) Maybe (PeerSelectionActionsTrace peeraddr lAddr)
_     = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
    severityFor (Namespace [Text]
_ [Text
"MonitoringResult"]) Maybe (PeerSelectionActionsTrace peeraddr lAddr)
_    = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"ConnectionError"]) Maybe (PeerSelectionActionsTrace peeraddr lAddr)
_     = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
    severityFor (Namespace [Text]
_ [Text
"PeerHotDuration"]) Maybe (PeerSelectionActionsTrace peeraddr lAddr)
_     = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor Namespace (PeerSelectionActionsTrace peeraddr lAddr)
_ Maybe (PeerSelectionActionsTrace peeraddr lAddr)
_                                     = Maybe SeverityS
forall a. Maybe a
Nothing

    documentFor :: Namespace (PeerSelectionActionsTrace peeraddr lAddr) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"StatusChanged"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
    documentFor (Namespace [Text]
_ [Text
"StatusChangeFailure"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
    documentFor (Namespace [Text]
_ [Text
"MonitoringError"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
    documentFor (Namespace [Text]
_ [Text
"MonitoringResult"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
    documentFor (Namespace [Text]
_ [Text
"ConnectionError"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
""
    documentFor (Namespace [Text]
_ [Text
"PeerHotDuration"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just
      Text
"Reports how long the outbound connection was in hot state"
    documentFor Namespace (PeerSelectionActionsTrace peeraddr lAddr)
_ = Maybe Text
forall a. Maybe a
Nothing

    allNamespaces :: [Namespace (PeerSelectionActionsTrace peeraddr lAddr)]
allNamespaces = [
        [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StatusChanged"]
      , [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"StatusChangeFailure"]
      , [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MonitoringError"]
      , [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MonitoringResult"]
      , [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ConnectionError"]
      , [Text]
-> [Text] -> Namespace (PeerSelectionActionsTrace peeraddr lAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PeerHotDuration"]
      ]