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

{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Network.Tracing.InboundGovernor () where

import Data.Aeson (Object, ToJSON, ToJSONKey, Value (String), toJSON, (.=))
import Data.Text (pack)

import Cardano.Logging
import Ouroboros.Network.ConnectionManager.Types qualified as ConnectionManager
import Ouroboros.Network.InboundGovernor as InboundGovernor (Trace (..))
import Ouroboros.Network.InboundGovernor qualified as InboundGovernor
-- Needed for `ToJSON SockAddr`.
-- Needed for `ToJSON LocalAddress`
-- Needed for `ToJSON (ConnectionId adr)`
-- Needed for `ToJSON MiniProtocolNum`
-- Needed for `ToJSON (ConnectionManager.OperationResult, ConnectionManager.AbstractState)`
-- Needed for `ToJSONKey (ConnectionId adr)`
-- Needed for `ToJSON InboundGovernor.RemoteSt`
import Ouroboros.Network.InboundGovernor.State as InboundGovernor
           (Counters (..))
import Ouroboros.Network.OrphanInstances qualified ()
import Ouroboros.Network.Snocket (LocalAddress (..), RemoteAddress)
import Ouroboros.Network.Util (PrettyShow)

--------------------------------------------------------------------------------
-- InboundGovernor Tracer
--------------------------------------------------------------------------------

instance LogFormatting (InboundGovernor.Trace RemoteAddress) where
  forMachine :: DetailLevel -> Trace RemoteAddress -> Object
forMachine = DetailLevel -> Trace RemoteAddress -> Object
forall adr.
(ToJSON adr, Show adr, ToJSONKey adr) =>
DetailLevel -> Trace adr -> Object
forMachineGov
  forHuman :: Trace RemoteAddress -> Text
forHuman = String -> Text
pack (String -> Text)
-> (Trace RemoteAddress -> String) -> Trace RemoteAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace RemoteAddress -> String
forall a. Show a => a -> String
show
  asMetrics :: Trace RemoteAddress -> [Metric]
asMetrics (TrInboundGovernorCounters InboundGovernor.Counters {Int
coldPeersRemote :: Int
idlePeersRemote :: Int
warmPeersRemote :: Int
hotPeersRemote :: Int
coldPeersRemote :: Counters -> Int
hotPeersRemote :: Counters -> Int
idlePeersRemote :: Counters -> Int
warmPeersRemote :: Counters -> Int
..}) =
            [ Text -> Integer -> Metric
IntM
                Text
"inboundGovernor.idle"
                (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idlePeersRemote)
            , Text -> Integer -> Metric
IntM
                Text
"inboundGovernor.cold"
                (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
coldPeersRemote)
            , Text -> Integer -> Metric
IntM
                Text
"inboundGovernor.warm"
                (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
warmPeersRemote)
            , Text -> Integer -> Metric
IntM
                Text
"inboundGovernor.hot"
                (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hotPeersRemote)
              ]
  asMetrics Trace RemoteAddress
_ = []

instance LogFormatting (InboundGovernor.Trace LocalAddress) where
  forMachine :: DetailLevel -> Trace LocalAddress -> Object
forMachine = DetailLevel -> Trace LocalAddress -> Object
forall adr.
(ToJSON adr, Show adr, ToJSONKey adr) =>
DetailLevel -> Trace adr -> Object
forMachineGov
  forHuman :: Trace LocalAddress -> Text
forHuman = String -> Text
pack (String -> Text)
-> (Trace LocalAddress -> String) -> Trace LocalAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace LocalAddress -> String
forall a. Show a => a -> String
show
  asMetrics :: Trace LocalAddress -> [Metric]
asMetrics (TrInboundGovernorCounters InboundGovernor.Counters {Int
coldPeersRemote :: Counters -> Int
hotPeersRemote :: Counters -> Int
idlePeersRemote :: Counters -> Int
warmPeersRemote :: Counters -> Int
coldPeersRemote :: Int
idlePeersRemote :: Int
warmPeersRemote :: Int
hotPeersRemote :: Int
..}) =
            [ Text -> Integer -> Metric
IntM
                Text
"localInboundGovernor.idle"
                (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idlePeersRemote)
            , Text -> Integer -> Metric
IntM
                Text
"localInboundGovernor.cold"
                (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
coldPeersRemote)
            , Text -> Integer -> Metric
IntM
                Text
"localInboundGovernor.warm"
                (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
warmPeersRemote)
            , Text -> Integer -> Metric
IntM
                Text
"localInboundGovernor.hot"
                (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hotPeersRemote)
              ]
  asMetrics Trace LocalAddress
_ = []


forMachineGov :: (ToJSON adr, Show adr, ToJSONKey adr) => DetailLevel -> InboundGovernor.Trace adr -> Object
forMachineGov :: forall adr.
(ToJSON adr, Show adr, ToJSONKey adr) =>
DetailLevel -> Trace adr -> Object
forMachineGov DetailLevel
_dtal (TrNewConnection Provenance
p ConnectionId adr
connId)            =
  [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
"NewConnection"
            , Key
"provenance" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Provenance -> String
forall a. Show a => a -> String
show Provenance
p
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            ]
forMachineGov DetailLevel
_dtal (TrResponderRestarted ConnectionId adr
connId MiniProtocolNum
m)       =
  [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
"ResponderStarted"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            , Key
"miniProtocolNum" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MiniProtocolNum -> Value
forall a. ToJSON a => a -> Value
toJSON MiniProtocolNum
m
            ]
forMachineGov DetailLevel
_dtal (TrResponderStartFailure ConnectionId adr
connId MiniProtocolNum
m 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
"ResponderStartFailure"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            , Key
"miniProtocolNum" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MiniProtocolNum -> Value
forall a. ToJSON a => a -> Value
toJSON MiniProtocolNum
m
            , 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
            ]
forMachineGov DetailLevel
_dtal (TrResponderErrored ConnectionId adr
connId MiniProtocolNum
m 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
"ResponderErrored"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            , Key
"miniProtocolNum" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MiniProtocolNum -> Value
forall a. ToJSON a => a -> Value
toJSON MiniProtocolNum
m
            , 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
            ]
forMachineGov DetailLevel
_dtal (TrResponderStarted ConnectionId adr
connId MiniProtocolNum
m)         =
  [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
"ResponderStarted"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            , Key
"miniProtocolNum" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MiniProtocolNum -> Value
forall a. ToJSON a => a -> Value
toJSON MiniProtocolNum
m
            ]
forMachineGov DetailLevel
_dtal (TrResponderTerminated ConnectionId adr
connId MiniProtocolNum
m)      =
  [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
"ResponderTerminated"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            , Key
"miniProtocolNum" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MiniProtocolNum -> Value
forall a. ToJSON a => a -> Value
toJSON MiniProtocolNum
m
            ]
forMachineGov DetailLevel
_dtal (TrPromotedToWarmRemote ConnectionId adr
connId OperationResult AbstractState
opRes) =
  [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
"PromotedToWarmRemote"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            , Key
"result" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OperationResult AbstractState -> Value
forall a. ToJSON a => a -> Value
toJSON OperationResult AbstractState
opRes
            ]
forMachineGov DetailLevel
_dtal (TrPromotedToHotRemote ConnectionId adr
connId)        =
  [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
"PromotedToHotRemote"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            ]
forMachineGov DetailLevel
_dtal (TrDemotedToColdRemote ConnectionId adr
connId OperationResult DemotedToColdRemoteTr
od)     =
  [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
"DemotedToColdRemote"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            , Key
"result" Key -> String -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OperationResult DemotedToColdRemoteTr -> String
forall a. Show a => a -> String
show OperationResult DemotedToColdRemoteTr
od
            ]
forMachineGov DetailLevel
_dtal (TrDemotedToWarmRemote ConnectionId adr
connId)     =
  [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
"DemotedToWarmRemote"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            ]
forMachineGov DetailLevel
_dtal (TrWaitIdleRemote ConnectionId adr
connId OperationResult AbstractState
opRes) =
  [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
"WaitIdleRemote"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            , Key
"result" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OperationResult AbstractState -> Value
forall a. ToJSON a => a -> Value
toJSON OperationResult AbstractState
opRes
            ]
forMachineGov DetailLevel
_dtal (TrMuxCleanExit ConnectionId adr
connId)               =
  [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
"MuxCleanExit"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
connId
            ]
forMachineGov DetailLevel
_dtal (TrMuxErrored ConnectionId adr
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
"MuxErrored"
            , 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 adr -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionId adr
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
            ]
forMachineGov DetailLevel
_dtal (TrInboundGovernorCounters Counters
counters) =
  [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
"InboundGovernorCounters"
            , Key
"idlePeers" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Counters -> Int
idlePeersRemote Counters
counters
            , Key
"coldPeers" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Counters -> Int
coldPeersRemote Counters
counters
            , Key
"warmPeers" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Counters -> Int
warmPeersRemote Counters
counters
            , Key
"hotPeers" Key -> Int -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Counters -> Int
hotPeersRemote Counters
counters
            ]
forMachineGov DetailLevel
_dtal (TrRemoteState Map (ConnectionId adr) RemoteSt
st) =
  [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
"RemoteState"
            , Key
"remoteSt" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (ConnectionId adr) RemoteSt -> Value
forall a. ToJSON a => a -> Value
toJSON Map (ConnectionId adr) RemoteSt
st
            ]
forMachineGov DetailLevel
_dtal (InboundGovernor.TrUnexpectedlyFalseAssertion IGAssertionLocation adr
info) =
  [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
"UnexpectedlyFalseAssertion"
            , Key
"remoteSt" 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)
-> (IGAssertionLocation adr -> String)
-> IGAssertionLocation adr
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IGAssertionLocation adr -> String
forall a. Show a => a -> String
show (IGAssertionLocation adr -> Text)
-> IGAssertionLocation adr -> Text
forall a b. (a -> b) -> a -> b
$ IGAssertionLocation adr
info)
            ]
forMachineGov DetailLevel
_dtal (InboundGovernor.TrInboundGovernorError SomeException
err) =
  [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
"InboundGovernorError"
            , Key
"remoteSt" 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)
-> (SomeException -> String) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show (SomeException -> Text) -> SomeException -> Text
forall a b. (a -> b) -> a -> b
$ SomeException
err)
            ]
forMachineGov DetailLevel
_dtal (InboundGovernor.TrMaturedConnections Set adr
matured Set adr
fresh) =
  [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
"MaturedConnections"
          , Key
"matured" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set adr -> Value
forall a. ToJSON a => a -> Value
toJSON Set adr
matured
          , Key
"fresh" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set adr -> Value
forall a. ToJSON a => a -> Value
toJSON Set adr
fresh
          ]
forMachineGov DetailLevel
_dtal (InboundGovernor.TrInactive [(adr, Time)]
fresh) =
  [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
"Inactive"
          , Key
"fresh" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(adr, Time)] -> Value
forall a. ToJSON a => a -> Value
toJSON [(adr, Time)]
fresh
          ]

instance MetaTrace (InboundGovernor.Trace addr) where
    namespaceFor :: Trace addr -> Namespace (Trace addr)
namespaceFor TrNewConnection {}         = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NewConnection"]
    namespaceFor TrResponderRestarted {}    = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderRestarted"]
    namespaceFor TrResponderStartFailure {} = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderStartFailure"]
    namespaceFor TrResponderErrored {}      = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderErrored"]
    namespaceFor TrResponderStarted {}      = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderStarted"]
    namespaceFor TrResponderTerminated {}   = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderTerminated"]
    namespaceFor TrPromotedToWarmRemote {}  = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PromotedToWarmRemote"]
    namespaceFor TrPromotedToHotRemote {}   = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PromotedToHotRemote"]
    namespaceFor TrDemotedToColdRemote {}   = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DemotedToColdRemote"]
    namespaceFor TrDemotedToWarmRemote {}   = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DemotedToWarmRemote"]
    namespaceFor TrWaitIdleRemote {}        = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WaitIdleRemote"]
    namespaceFor TrMuxCleanExit {}          = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MuxCleanExit"]
    namespaceFor TrMuxErrored {}            = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MuxErrored"]
    namespaceFor TrInboundGovernorCounters {} = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InboundGovernorCounters"]
    namespaceFor TrRemoteState {}            = [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RemoteState"]
    namespaceFor InboundGovernor.TrUnexpectedlyFalseAssertion {} =
                                [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"UnexpectedlyFalseAssertion"]
    namespaceFor InboundGovernor.TrInboundGovernorError {} =
                                [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InboundGovernorError"]
    namespaceFor InboundGovernor.TrMaturedConnections {} =
                                [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MaturedConnections"]
    namespaceFor InboundGovernor.TrInactive {} =
                                [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Inactive"]

    severityFor :: Namespace (Trace addr) -> Maybe (Trace addr) -> Maybe SeverityS
severityFor (Namespace [Text]
_ [Text
"NewConnection"]) Maybe (Trace addr)
_              = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"ResponderRestarted"]) Maybe (Trace addr)
_         = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"ResponderStartFailure"]) Maybe (Trace addr)
_      = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"ResponderErrored"]) Maybe (Trace addr)
_           = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"ResponderStarted"]) Maybe (Trace addr)
_           = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"ResponderTerminated"]) Maybe (Trace addr)
_        = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"PromotedToWarmRemote"]) Maybe (Trace addr)
_       = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"PromotedToHotRemote"]) Maybe (Trace addr)
_        = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"DemotedToColdRemote"]) Maybe (Trace addr)
_        = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"DemotedToWarmRemote"]) Maybe (Trace addr)
_        = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"WaitIdleRemote"]) Maybe (Trace addr)
_             = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"MuxCleanExit"]) Maybe (Trace addr)
_               = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"MuxErrored"]) Maybe (Trace addr)
_                 = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"InboundGovernorCounters"]) Maybe (Trace addr)
_    = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"RemoteState"]) Maybe (Trace addr)
_                = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor (Namespace [Text]
_ [Text
"UnexpectedlyFalseAssertion"]) Maybe (Trace addr)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
    severityFor (Namespace [Text]
_ [Text
"InboundGovernorError"]) Maybe (Trace addr)
_       = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error
    severityFor (Namespace [Text]
_ [Text
"MaturedConnections"]) Maybe (Trace addr)
_         = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info
    severityFor (Namespace [Text]
_ [Text
"Inactive"]) Maybe (Trace addr)
_                   = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor Namespace (Trace addr)
_ Maybe (Trace addr)
_                                            = Maybe SeverityS
forall a. Maybe a
Nothing

    documentFor :: Namespace (Trace addr) -> Maybe Text
documentFor (Namespace [Text]
_ [Text
"NewConnection"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"ResponderRestarted"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"ResponderStartFailure"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"ResponderErrored"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"ResponderStarted"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"ResponderTerminated"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"PromotedToWarmRemote"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"PromotedToHotRemote"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"DemotedToColdRemote"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"All mini-protocols terminated.  The boolean is true if this connection"
      , Text
" was not used by p2p-governor, and thus the connection will be terminated."
      ]
    documentFor (Namespace [Text]
_ [Text
"DemotedToWarmRemote"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"All mini-protocols terminated.  The boolean is true if this connection"
      , Text
" was not used by p2p-governor, and thus the connection will be terminated."
      ]
    documentFor (Namespace [Text]
_ [Text
"WaitIdleRemote"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"MuxCleanExit"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"MuxErrored"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"InboundGovernorCounters"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"RemoteState"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"UnexpectedlyFalseAssertion"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"InboundGovernorError"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"MaturedConnections"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor (Namespace [Text]
_ [Text
"Inactive"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor Namespace (Trace addr)
_ = Maybe Text
forall a. Maybe a
Nothing

    metricsDocFor :: Namespace (Trace addr) -> [(Text, Text)]
metricsDocFor (Namespace [Text]
ons [Text
"InboundGovernorCounters"])
      | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ons -- docu generation
        =
              [(Text
"localInboundGovernor.idle",Text
"")
              ,(Text
"localInboundGovernor.cold",Text
"")
              ,(Text
"localInboundGovernor.warm",Text
"")
              ,(Text
"localInboundGovernor.hot",Text
"")
              ,(Text
"inboundGovernor.Idle",Text
"")
              ,(Text
"inboundGovernor.Cold",Text
"")
              ,(Text
"inboundGovernor.Warm",Text
"")
              ,(Text
"inboundGovernor.Hot",Text
"")
              ]
      | [Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
ons Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Local"
        =
              [(Text
"localInboundGovernor.idle",Text
"")
              ,(Text
"localInboundGovernor.cold",Text
"")
              ,(Text
"localInboundGovernor.warm",Text
"")
              ,(Text
"localInboundGovernor.hot",Text
"")
              ]
      | Bool
otherwise
        =
              [(Text
"inboundGovernor.Idle",Text
"")
              ,(Text
"inboundGovernor.Cold",Text
"")
              ,(Text
"inboundGovernor.Warm",Text
"")
              ,(Text
"inboundGovernor.Hot",Text
"")
              ]
    metricsDocFor Namespace (Trace addr)
_ = []

    allNamespaces :: [Namespace (Trace addr)]
allNamespaces = [
        [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"NewConnection"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderRestarted"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderStartFailure"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderErrored"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderStarted"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"ResponderTerminated"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PromotedToWarmRemote"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"PromotedToHotRemote"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DemotedToColdRemote"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"DemotedToWarmRemote"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"WaitIdleRemote"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MuxCleanExit"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MuxErrored"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InboundGovernorCounters"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"RemoteState"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"UnexpectedlyFalseAssertion"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"InboundGovernorError"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"MaturedConnections"]
      , [Text] -> [Text] -> Namespace (Trace addr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Inactive"]
      ]

--------------------------------------------------------------------------------
-- InboundGovernor Transition Tracer
--------------------------------------------------------------------------------

instance (PrettyShow peerAddr, ToJSON peerAddr)
      => LogFormatting (InboundGovernor.RemoteTransitionTrace peerAddr) where
    forMachine :: DetailLevel -> RemoteTransitionTrace peerAddr -> Object
forMachine DetailLevel
_dtal (InboundGovernor.TransitionTrace peerAddr
peerAddr Transition' (Maybe RemoteSt)
tr) =
      [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ [Object] -> [Object]
forall a. [a] -> [a]
reverse
        [ 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
"ConnectionManagerTransition"
        , Key
"address" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= peerAddr -> Value
forall a. ToJSON a => a -> Value
toJSON peerAddr
peerAddr
        , Key
"from"    Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe RemoteSt -> Value
forall a. ToJSON a => a -> Value
toJSON (Transition' (Maybe RemoteSt) -> Maybe RemoteSt
forall state. Transition' state -> state
ConnectionManager.fromState Transition' (Maybe RemoteSt)
tr)
        , Key
"to"      Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe RemoteSt -> Value
forall a. ToJSON a => a -> Value
toJSON (Transition' (Maybe RemoteSt) -> Maybe RemoteSt
forall state. Transition' state -> state
ConnectionManager.toState   Transition' (Maybe RemoteSt)
tr)
        ]
    forHuman :: RemoteTransitionTrace peerAddr -> Text
forHuman = String -> Text
pack (String -> Text)
-> (RemoteTransitionTrace peerAddr -> String)
-> RemoteTransitionTrace peerAddr
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteTransitionTrace peerAddr -> String
forall a. Show a => a -> String
show
    asMetrics :: RemoteTransitionTrace peerAddr -> [Metric]
asMetrics RemoteTransitionTrace peerAddr
_ = []

instance MetaTrace (InboundGovernor.RemoteTransitionTrace peerAddr) where
    namespaceFor :: RemoteTransitionTrace peerAddr
-> Namespace (RemoteTransitionTrace peerAddr)
namespaceFor InboundGovernor.TransitionTrace {} = [Text] -> [Text] -> Namespace (RemoteTransitionTrace peerAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Transition"]

    severityFor :: Namespace (RemoteTransitionTrace peerAddr)
-> Maybe (RemoteTransitionTrace peerAddr) -> Maybe SeverityS
severityFor  (Namespace [] [Text
"Transition"]) Maybe (RemoteTransitionTrace peerAddr)
_ = SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug
    severityFor Namespace (RemoteTransitionTrace peerAddr)
_ Maybe (RemoteTransitionTrace peerAddr)
_                              = Maybe SeverityS
forall a. Maybe a
Nothing

    documentFor :: Namespace (RemoteTransitionTrace peerAddr) -> Maybe Text
documentFor  (Namespace [] [Text
"Transition"]) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
    documentFor Namespace (RemoteTransitionTrace peerAddr)
_                              = Maybe Text
forall a. Maybe a
Nothing

    allNamespaces :: [Namespace (RemoteTransitionTrace peerAddr)]
allNamespaces = [[Text] -> [Text] -> Namespace (RemoteTransitionTrace peerAddr)
forall a. [Text] -> [Text] -> Namespace a
Namespace [] [Text
"Transition"]]