{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-orphans  #-}

module Cardano.Node.Tracing.Tracers.Diffusion
  (
    severityMux
  , namesForMux
  , docMuxLocal
  , docMuxRemote

  , severityHandshake
  , namesForHandshake
  , docHandshake

  , severityLocalHandshake
  , namesForLocalHandshake
  , docLocalHandshake

  , severityDiffusionInit
  , namesForDiffusionInit
  , docDiffusionInit

  , severityLedgerPeers
  , namesForLedgerPeers
  , docLedgerPeers
  ) where

import           Cardano.Logging
import           Cardano.Prelude hiding (Show, show)
import qualified Codec.CBOR.Term as CBOR
import           Data.Aeson (Value (String), (.=))
import           Data.Text (pack)
import           Network.Mux (MuxTrace (..), WithMuxBearer (..))
import qualified Network.Socket as Socket
import           Network.TypedProtocol.Codec (AnyMessageAndAgency (..))
import           Text.Show

import           Cardano.Node.Configuration.TopologyP2P (UseLedger (..))

import qualified Ouroboros.Network.Diffusion as ND
import           Ouroboros.Network.Driver.Simple (TraceSendRecv (..))
import qualified Ouroboros.Network.NodeToClient as NtC
import qualified Ouroboros.Network.NodeToNode as NtN
import           Ouroboros.Network.PeerSelection.LedgerPeers (NumberOfPeers (..),
                   PoolStake (..), TraceLedgerPeers (..))
import           Ouroboros.Network.Protocol.BlockFetch.Type (Message (..))
import qualified Ouroboros.Network.Protocol.Handshake.Type as HS
import           Ouroboros.Network.Snocket (LocalAddress (..))


--------------------------------------------------------------------------------
-- Mux Tracer
--------------------------------------------------------------------------------

severityMux :: WithMuxBearer peer MuxTrace -> SeverityS
severityMux :: WithMuxBearer peer MuxTrace -> SeverityS
severityMux (WithMuxBearer peer
_ MuxTrace
mt) = MuxTrace -> SeverityS
severityMux' MuxTrace
mt

severityMux' :: MuxTrace -> SeverityS
severityMux' :: MuxTrace -> SeverityS
severityMux' MuxTraceRecvHeaderStart {}       = SeverityS
Debug
severityMux' MuxTraceRecvHeaderEnd {}         = SeverityS
Debug
severityMux' MuxTraceRecvStart {}             = SeverityS
Debug
severityMux' MuxTraceRecvEnd {}               = SeverityS
Debug
severityMux' MuxTraceSendStart {}             = SeverityS
Debug
severityMux' MuxTrace
MuxTraceSendEnd                  = SeverityS
Debug
severityMux' MuxTraceState {}                 = SeverityS
Info
severityMux' MuxTraceCleanExit {}             = SeverityS
Notice
severityMux' MuxTraceExceptionExit {}         = SeverityS
Notice
severityMux' MuxTraceChannelRecvStart {}      = SeverityS
Debug
severityMux' MuxTraceChannelRecvEnd {}        = SeverityS
Debug
severityMux' MuxTraceChannelSendStart {}      = SeverityS
Debug
severityMux' MuxTraceChannelSendEnd {}        = SeverityS
Debug
severityMux' MuxTrace
MuxTraceHandshakeStart           = SeverityS
Debug
severityMux' MuxTraceHandshakeClientEnd {}    = SeverityS
Info
severityMux' MuxTrace
MuxTraceHandshakeServerEnd       = SeverityS
Debug
severityMux' MuxTraceHandshakeClientError {}  = SeverityS
Error
severityMux' MuxTraceHandshakeServerError {}  = SeverityS
Error
severityMux' MuxTraceRecvDeltaQObservation {} = SeverityS
Debug
severityMux' MuxTraceRecvDeltaQSample {}      = SeverityS
Debug
severityMux' MuxTrace
MuxTraceSDUReadTimeoutException  = SeverityS
Notice
severityMux' MuxTrace
MuxTraceSDUWriteTimeoutException = SeverityS
Notice
severityMux' MuxTraceStartEagerly {}          = SeverityS
Debug
severityMux' MuxTraceStartOnDemand {}         = SeverityS
Debug
severityMux' MuxTraceStartedOnDemand {}       = SeverityS
Debug
severityMux' MuxTraceTerminating {}           = SeverityS
Debug
severityMux' MuxTraceShutdown {}              = SeverityS
Debug
severityMux' MuxTraceTCPInfo {}               = SeverityS
Debug

namesForMux :: WithMuxBearer peer MuxTrace -> [Text]
namesForMux :: WithMuxBearer peer MuxTrace -> [Text]
namesForMux (WithMuxBearer peer
_ MuxTrace
mt) = MuxTrace -> [Text]
namesForMux' MuxTrace
mt

namesForMux' :: MuxTrace -> [Text]
namesForMux' :: MuxTrace -> [Text]
namesForMux' MuxTraceRecvHeaderStart {}       = [Text
"RecvHeaderStart"]
namesForMux' MuxTraceRecvHeaderEnd {}         = [Text
"RecvHeaderEnd"]
namesForMux' MuxTraceRecvStart {}             = [Text
"RecvStart"]
namesForMux' MuxTraceRecvEnd {}               = [Text
"RecvEnd"]
namesForMux' MuxTraceSendStart {}             = [Text
"SendStart"]
namesForMux' MuxTrace
MuxTraceSendEnd                  = [Text
"SendEnd"]
namesForMux' MuxTraceState {}                 = [Text
"State"]
namesForMux' MuxTraceCleanExit {}             = [Text
"CleanExit"]
namesForMux' MuxTraceExceptionExit {}         = [Text
"ExceptionExit"]
namesForMux' MuxTraceChannelRecvStart {}      = [Text
"ChannelRecvStart"]
namesForMux' MuxTraceChannelRecvEnd {}        = [Text
"ChannelRecvEnd"]
namesForMux' MuxTraceChannelSendStart {}      = [Text
"ChannelSendStart"]
namesForMux' MuxTraceChannelSendEnd {}        = [Text
"ChannelSendEnd"]
namesForMux' MuxTrace
MuxTraceHandshakeStart           = [Text
"HandshakeStart "]
namesForMux' MuxTraceHandshakeClientEnd {}    = [Text
"HandshakeClientEnd"]
namesForMux' MuxTrace
MuxTraceHandshakeServerEnd       = [Text
"HandshakeServerEnd"]
namesForMux' MuxTraceHandshakeClientError {}  = [Text
"HandshakeClientError"]
namesForMux' MuxTraceHandshakeServerError {}  = [Text
"HandshakeServerError"]
namesForMux' MuxTraceRecvDeltaQObservation {} = [Text
"RecvDeltaQObservation"]
namesForMux' MuxTraceRecvDeltaQSample {}      = [Text
"RecvDeltaQSample"]
namesForMux' MuxTrace
MuxTraceSDUReadTimeoutException  = [Text
"SDUReadTimeoutException"]
namesForMux' MuxTrace
MuxTraceSDUWriteTimeoutException = [Text
"SDUWriteTimeoutException"]
namesForMux' MuxTraceStartEagerly {}          = [Text
"StartEagerly"]
namesForMux' MuxTraceStartOnDemand {}         = [Text
"StartOnDemand"]
namesForMux' MuxTraceStartedOnDemand {}       = [Text
"StartedOnDemand"]
namesForMux' MuxTraceTerminating {}           = [Text
"Terminating"]
namesForMux' MuxTraceShutdown {}              = [Text
"Shutdown"]
namesForMux' MuxTraceTCPInfo {}               = [Text
"TCPInfo"]



instance (LogFormatting peer, Show peer) =>
    LogFormatting (WithMuxBearer peer MuxTrace) where
  forMachine :: DetailLevel -> WithMuxBearer peer MuxTrace -> Object
forMachine DetailLevel
dtal (WithMuxBearer peer
b MuxTrace
ev) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"MuxTrace"
             , Key
"bearer" Key -> Object -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DetailLevel -> peer -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
dtal peer
b
             , Key
"event" Key -> Text -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MuxTrace -> Text
forall a. Show a => a -> Text
showT MuxTrace
ev ]
  forHuman :: WithMuxBearer peer MuxTrace -> Text
forHuman (WithMuxBearer peer
b MuxTrace
ev) = Text
"With mux bearer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> peer -> Text
forall a. Show a => a -> Text
showT peer
b
                                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MuxTrace -> Text
forall a. Show a => a -> Text
showT MuxTrace
ev


docMuxLocal :: Documented (WithMuxBearer (NtN.ConnectionId LocalAddress) MuxTrace)
docMuxLocal :: Documented (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
docMuxLocal = [Text]
-> Documented (WithMuxBearer Any MuxTrace)
-> Documented (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace  [] Documented (WithMuxBearer Any MuxTrace)
forall peer. Documented (WithMuxBearer peer MuxTrace)
docMux'

docMuxRemote :: Documented (WithMuxBearer (NtN.ConnectionId NtN.RemoteAddress) MuxTrace)
docMuxRemote :: Documented (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)
docMuxRemote = [Text]
-> Documented (WithMuxBearer Any MuxTrace)
-> Documented (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace  [] Documented (WithMuxBearer Any MuxTrace)
forall peer. Documented (WithMuxBearer peer MuxTrace)
docMux'


docMux' :: Documented (WithMuxBearer peer MuxTrace)
docMux' :: Documented (WithMuxBearer peer MuxTrace)
docMux' = [DocMsg (WithMuxBearer peer MuxTrace)]
-> Documented (WithMuxBearer peer MuxTrace)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"RecvHeaderStart"]
        []
        Text
"Bearer receive header start."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"RecvHeaderEnd"]
        []
        Text
"Bearer receive header end."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"RecvStart"]
        []
        Text
"Bearer receive start."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"RecvEnd"]
        []
        Text
"Bearer receive end."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"SendStart"]
        []
        Text
"Bearer send start."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"SendEnd"]
        []
        Text
"Bearer send end."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"State"]
        []
        Text
"State."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"CleanExit"]
        []
        Text
"Miniprotocol terminated cleanly."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ExceptionExit"]
        []
        Text
"Miniprotocol terminated with exception."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ChannelRecvStart"]
        []
        Text
"Channel receive start."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ChannelRecvEnd"]
        []
        Text
"Channel receive end."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ChannelSendStart"]
        []
        Text
"Channel send start."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ChannelSendEnd"]
        []
        Text
"Channel send end."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"HandshakeStart"]
        []
        Text
"Handshake start."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"HandshakeClientEnd"]
        []
        Text
"Handshake client end."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"HandshakeServerEnd"]
        []
        Text
"Handshake server end."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"HandshakeClientError"]
        []
        Text
"Handshake client error."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"HandshakeServerError"]
        []
        Text
"Handshake server error."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"RecvDeltaQObservation"]
        []
        Text
"Bearer DeltaQ observation."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"RecvDeltaQSample"]
        []
        Text
"Bearer DeltaQ sample."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"SDUReadTimeoutException"]
        []
        Text
"Timed out reading SDU."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"SDUWriteTimeoutException"]
        []
        Text
"Timed out writing SDU."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"StartEagerly"]
        []
        Text
"Eagerly started."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"StartOnDemand"]
        []
        Text
"Preparing to start."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"StartedOnDemand"]
        []
        Text
"Started on demand."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"Terminating"]
        []
        Text
"Terminating."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"Shutdown"]
        []
        Text
"Mux shutdown."
    , [Text]
-> [(Text, Text)] -> Text -> DocMsg (WithMuxBearer peer MuxTrace)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"TCPInfo"]
        []
        Text
"TCPInfo."
    ]

--------------------------------------------------------------------------------
-- Handshake Tracer
--------------------------------------------------------------------------------

severityHandshake :: NtN.HandshakeTr adr ver -> SeverityS
severityHandshake :: HandshakeTr adr ver -> SeverityS
severityHandshake (WithMuxBearer ConnectionId adr
_ TraceSendRecv (Handshake ver Term)
e) = TraceSendRecv (Handshake ver Term) -> SeverityS
forall nt. TraceSendRecv (Handshake nt Term) -> SeverityS
severityHandshake' TraceSendRecv (Handshake ver Term)
e

severityHandshake' ::
     TraceSendRecv (HS.Handshake nt CBOR.Term)
  -> SeverityS
severityHandshake' :: TraceSendRecv (Handshake nt Term) -> SeverityS
severityHandshake' (TraceSendMsg AnyMessageAndAgency (Handshake nt Term)
m) = AnyMessageAndAgency (Handshake nt Term) -> SeverityS
forall nt. AnyMessageAndAgency (Handshake nt Term) -> SeverityS
severityHandshake'' AnyMessageAndAgency (Handshake nt Term)
m
severityHandshake' (TraceRecvMsg AnyMessageAndAgency (Handshake nt Term)
m) = AnyMessageAndAgency (Handshake nt Term) -> SeverityS
forall nt. AnyMessageAndAgency (Handshake nt Term) -> SeverityS
severityHandshake'' AnyMessageAndAgency (Handshake nt Term)
m

severityHandshake'' :: AnyMessageAndAgency (HS.Handshake nt CBOR.Term) -> SeverityS
severityHandshake'' :: AnyMessageAndAgency (Handshake nt Term) -> SeverityS
severityHandshake'' (AnyMessageAndAgency PeerHasAgency pr st
_agency Message (Handshake nt Term) st st'
msg) = Message (Handshake nt Term) st st' -> SeverityS
forall nt (from :: Handshake nt Term) (to :: Handshake nt Term).
Message (Handshake nt Term) from to -> SeverityS
severityHandshake''' Message (Handshake nt Term) st st'
msg

severityHandshake''' :: Message (HS.Handshake nt CBOR.Term) from to -> SeverityS
severityHandshake''' :: Message (Handshake nt Term) from to -> SeverityS
severityHandshake''' HS.MsgProposeVersions {} = SeverityS
Info
severityHandshake''' HS.MsgReplyVersions {}   = SeverityS
Info
severityHandshake''' HS.MsgAcceptVersion {}   = SeverityS
Info
severityHandshake''' HS.MsgRefuse {}          = SeverityS
Info

namesForHandshake :: NtN.HandshakeTr adr ver -> [Text]
namesForHandshake :: HandshakeTr adr ver -> [Text]
namesForHandshake (WithMuxBearer ConnectionId adr
_ TraceSendRecv (Handshake ver Term)
e) = TraceSendRecv (Handshake ver Term) -> [Text]
forall nt. TraceSendRecv (Handshake nt Term) -> [Text]
namesForHandshake' TraceSendRecv (Handshake ver Term)
e

namesForHandshake' ::
     TraceSendRecv (HS.Handshake nt CBOR.Term)
  -> [Text]
namesForHandshake' :: TraceSendRecv (Handshake nt Term) -> [Text]
namesForHandshake' (TraceSendMsg AnyMessageAndAgency (Handshake nt Term)
m) = Text
"Send" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: AnyMessageAndAgency (Handshake nt Term) -> [Text]
forall nt. AnyMessageAndAgency (Handshake nt Term) -> [Text]
namesForHandshake'' AnyMessageAndAgency (Handshake nt Term)
m
namesForHandshake' (TraceRecvMsg AnyMessageAndAgency (Handshake nt Term)
m) = Text
"Recieve" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: AnyMessageAndAgency (Handshake nt Term) -> [Text]
forall nt. AnyMessageAndAgency (Handshake nt Term) -> [Text]
namesForHandshake'' AnyMessageAndAgency (Handshake nt Term)
m

namesForHandshake'' :: AnyMessageAndAgency (HS.Handshake nt CBOR.Term) -> [Text]
namesForHandshake'' :: AnyMessageAndAgency (Handshake nt Term) -> [Text]
namesForHandshake'' (AnyMessageAndAgency PeerHasAgency pr st
_agency Message (Handshake nt Term) st st'
msg) = Message (Handshake nt Term) st st' -> [Text]
forall nt (from :: Handshake nt Term) (to :: Handshake nt Term).
Message (Handshake nt Term) from to -> [Text]
namesForHandshake''' Message (Handshake nt Term) st st'
msg

namesForHandshake''' :: Message (HS.Handshake nt CBOR.Term) from to -> [Text]
namesForHandshake''' :: Message (Handshake nt Term) from to -> [Text]
namesForHandshake''' HS.MsgProposeVersions {} = [Text
"ProposeVersions"]
namesForHandshake''' HS.MsgReplyVersions {}   = [Text
"ReplyVersions"]
namesForHandshake''' HS.MsgAcceptVersion {}   = [Text
"AcceptVersion"]
namesForHandshake''' HS.MsgRefuse {}          = [Text
"Refuse"]

instance LogFormatting (NtN.HandshakeTr NtN.RemoteAddress NtN.NodeToNodeVersion) where
  forMachine :: DetailLevel
-> HandshakeTr RemoteAddress NodeToNodeVersion -> Object
forMachine DetailLevel
_dtal (WithMuxBearer ConnectionId RemoteAddress
b TraceSendRecv (Handshake NodeToNodeVersion Term)
ev) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"HandshakeTrace"
             , Key
"bearer" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ConnectionId RemoteAddress -> String
forall a. Show a => a -> String
show ConnectionId RemoteAddress
b
             , Key
"event" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TraceSendRecv (Handshake NodeToNodeVersion Term) -> String
forall a. Show a => a -> String
show TraceSendRecv (Handshake NodeToNodeVersion Term)
ev ]
  forHuman :: HandshakeTr RemoteAddress NodeToNodeVersion -> Text
forHuman (WithMuxBearer ConnectionId RemoteAddress
b TraceSendRecv (Handshake NodeToNodeVersion Term)
ev) = Text
"With mux bearer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConnectionId RemoteAddress -> Text
forall a. Show a => a -> Text
showT ConnectionId RemoteAddress
b
                                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TraceSendRecv (Handshake NodeToNodeVersion Term) -> Text
forall a. Show a => a -> Text
showT TraceSendRecv (Handshake NodeToNodeVersion Term)
ev

docHandshake :: Documented (NtN.HandshakeTr NtN.RemoteAddress ver)
docHandshake :: Documented (HandshakeTr RemoteAddress ver)
docHandshake = [Text]
-> Documented (HandshakeTr Any Any)
-> Documented (HandshakeTr RemoteAddress ver)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace  [Text
"Send"] Documented (HandshakeTr Any Any)
forall adr ver. Documented (HandshakeTr adr ver)
docHandshake'
               Documented (HandshakeTr RemoteAddress ver)
-> Documented (HandshakeTr RemoteAddress ver)
-> Documented (HandshakeTr RemoteAddress ver)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (HandshakeTr Any Any)
-> Documented (HandshakeTr RemoteAddress ver)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace  [Text
"Receive"] Documented (HandshakeTr Any Any)
forall adr ver. Documented (HandshakeTr adr ver)
docHandshake'

docHandshake' :: Documented (NtN.HandshakeTr adr ver)
docHandshake' :: Documented (HandshakeTr adr ver)
docHandshake' = [DocMsg (HandshakeTr adr ver)] -> Documented (HandshakeTr adr ver)
forall a. [DocMsg a] -> Documented a
Documented [
      [Text] -> [(Text, Text)] -> Text -> DocMsg (HandshakeTr adr ver)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ProposeVersions"]
        []
        Text
"Propose versions together with version parameters.  It must be\
        \ encoded to a sorted list.."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (HandshakeTr adr ver)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"ReplyVersions"]
        []
        Text
"`MsgReplyVersions` received as a response to 'MsgProposeVersions'.  It\
        \ is not supported to explicitly send this message. It can only be\
        \ received as a copy of 'MsgProposeVersions' in a simultaneous open\
        \ scenario."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (HandshakeTr adr ver)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"AcceptVersion"]
        []
        Text
"The remote end decides which version to use and sends chosen version.\
        \The server is allowed to modify version parameters."
    , [Text] -> [(Text, Text)] -> Text -> DocMsg (HandshakeTr adr ver)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
        [Text
"Refuse"]
        []
        Text
"It refuses to run any version."
    ]

--------------------------------------------------------------------------------
-- LocalHandshake Tracer
--------------------------------------------------------------------------------

severityLocalHandshake :: NtC.HandshakeTr adr ver -> SeverityS
severityLocalHandshake :: HandshakeTr adr ver -> SeverityS
severityLocalHandshake (WithMuxBearer ConnectionId adr
_ TraceSendRecv (Handshake ver Term)
e) = TraceSendRecv (Handshake ver Term) -> SeverityS
forall nt. TraceSendRecv (Handshake nt Term) -> SeverityS
severityLocalHandshake' TraceSendRecv (Handshake ver Term)
e

severityLocalHandshake' ::
     TraceSendRecv (HS.Handshake nt CBOR.Term)
  -> SeverityS
severityLocalHandshake' :: TraceSendRecv (Handshake nt Term) -> SeverityS
severityLocalHandshake' (TraceSendMsg AnyMessageAndAgency (Handshake nt Term)
m) = AnyMessageAndAgency (Handshake nt Term) -> SeverityS
forall nt. AnyMessageAndAgency (Handshake nt Term) -> SeverityS
severityLocalHandshake'' AnyMessageAndAgency (Handshake nt Term)
m
severityLocalHandshake' (TraceRecvMsg AnyMessageAndAgency (Handshake nt Term)
m) = AnyMessageAndAgency (Handshake nt Term) -> SeverityS
forall nt. AnyMessageAndAgency (Handshake nt Term) -> SeverityS
severityLocalHandshake'' AnyMessageAndAgency (Handshake nt Term)
m

severityLocalHandshake'' :: AnyMessageAndAgency (HS.Handshake nt CBOR.Term) -> SeverityS
severityLocalHandshake'' :: AnyMessageAndAgency (Handshake nt Term) -> SeverityS
severityLocalHandshake'' (AnyMessageAndAgency PeerHasAgency pr st
_agency Message (Handshake nt Term) st st'
msg) = Message (Handshake nt Term) st st' -> SeverityS
forall nt (from :: Handshake nt Term) (to :: Handshake nt Term).
Message (Handshake nt Term) from to -> SeverityS
severityLocalHandshake''' Message (Handshake nt Term) st st'
msg

severityLocalHandshake''' :: Message (HS.Handshake nt CBOR.Term) from to -> SeverityS
severityLocalHandshake''' :: Message (Handshake nt Term) from to -> SeverityS
severityLocalHandshake''' HS.MsgProposeVersions {} = SeverityS
Info
severityLocalHandshake''' HS.MsgReplyVersions {}   = SeverityS
Info
severityLocalHandshake''' HS.MsgAcceptVersion {}   = SeverityS
Info
severityLocalHandshake''' HS.MsgRefuse {}          = SeverityS
Info

namesForLocalHandshake :: NtC.HandshakeTr adr ver -> [Text]
namesForLocalHandshake :: HandshakeTr adr ver -> [Text]
namesForLocalHandshake (WithMuxBearer ConnectionId adr
_ TraceSendRecv (Handshake ver Term)
e) = TraceSendRecv (Handshake ver Term) -> [Text]
forall nt. TraceSendRecv (Handshake nt Term) -> [Text]
namesForLocalHandshake' TraceSendRecv (Handshake ver Term)
e

namesForLocalHandshake' ::
     TraceSendRecv (HS.Handshake nt CBOR.Term)
  -> [Text]
namesForLocalHandshake' :: TraceSendRecv (Handshake nt Term) -> [Text]
namesForLocalHandshake' (TraceSendMsg AnyMessageAndAgency (Handshake nt Term)
m) = Text
"Send" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: AnyMessageAndAgency (Handshake nt Term) -> [Text]
forall nt. AnyMessageAndAgency (Handshake nt Term) -> [Text]
namesForLocalHandshake'' AnyMessageAndAgency (Handshake nt Term)
m
namesForLocalHandshake' (TraceRecvMsg AnyMessageAndAgency (Handshake nt Term)
m) = Text
"Receive" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: AnyMessageAndAgency (Handshake nt Term) -> [Text]
forall nt. AnyMessageAndAgency (Handshake nt Term) -> [Text]
namesForLocalHandshake'' AnyMessageAndAgency (Handshake nt Term)
m

namesForLocalHandshake'' :: AnyMessageAndAgency (HS.Handshake nt CBOR.Term) -> [Text]
namesForLocalHandshake'' :: AnyMessageAndAgency (Handshake nt Term) -> [Text]
namesForLocalHandshake'' (AnyMessageAndAgency PeerHasAgency pr st
_agency Message (Handshake nt Term) st st'
msg) = Message (Handshake nt Term) st st' -> [Text]
forall nt (from :: Handshake nt Term) (to :: Handshake nt Term).
Message (Handshake nt Term) from to -> [Text]
namesForLocalHandshake''' Message (Handshake nt Term) st st'
msg

namesForLocalHandshake''' :: Message (HS.Handshake nt CBOR.Term) from to -> [Text]
namesForLocalHandshake''' :: Message (Handshake nt Term) from to -> [Text]
namesForLocalHandshake''' HS.MsgProposeVersions {} = [Text
"ProposeVersions"]
namesForLocalHandshake''' HS.MsgReplyVersions {}   = [Text
"ReplyVersions"]
namesForLocalHandshake''' HS.MsgAcceptVersion {}   = [Text
"AcceptVersion"]
namesForLocalHandshake''' HS.MsgRefuse {}          = [Text
"Refuse"]

instance LogFormatting (NtC.HandshakeTr NtC.LocalAddress NtC.NodeToClientVersion) where
  forMachine :: DetailLevel
-> HandshakeTr LocalAddress NodeToClientVersion -> Object
forMachine DetailLevel
_dtal (WithMuxBearer ConnectionId LocalAddress
b TraceSendRecv (Handshake NodeToClientVersion Term)
ev) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LocalHandshakeTrace"
             , Key
"bearer" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ConnectionId LocalAddress -> String
forall a. Show a => a -> String
show ConnectionId LocalAddress
b
             , Key
"event" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TraceSendRecv (Handshake NodeToClientVersion Term) -> String
forall a. Show a => a -> String
show TraceSendRecv (Handshake NodeToClientVersion Term)
ev ]
  forHuman :: HandshakeTr LocalAddress NodeToClientVersion -> Text
forHuman (WithMuxBearer ConnectionId LocalAddress
b TraceSendRecv (Handshake NodeToClientVersion Term)
ev) = Text
"With mux bearer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConnectionId LocalAddress -> Text
forall a. Show a => a -> Text
showT ConnectionId LocalAddress
b
                                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TraceSendRecv (Handshake NodeToClientVersion Term) -> Text
forall a. Show a => a -> Text
showT TraceSendRecv (Handshake NodeToClientVersion Term)
ev

docLocalHandshake :: Documented (NtC.HandshakeTr LocalAddress ver)
docLocalHandshake :: Documented (HandshakeTr LocalAddress ver)
docLocalHandshake = [Text]
-> Documented (HandshakeTr Any Any)
-> Documented (HandshakeTr LocalAddress ver)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace  [Text
"Send"] Documented (HandshakeTr Any Any)
forall adr ver. Documented (HandshakeTr adr ver)
docHandshake'
               Documented (HandshakeTr LocalAddress ver)
-> Documented (HandshakeTr LocalAddress ver)
-> Documented (HandshakeTr LocalAddress ver)
forall a. Documented a -> Documented a -> Documented a
`addDocs` [Text]
-> Documented (HandshakeTr Any Any)
-> Documented (HandshakeTr LocalAddress ver)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace  [Text
"Receive"] Documented (HandshakeTr Any Any)
forall adr ver. Documented (HandshakeTr adr ver)
docHandshake'

--------------------------------------------------------------------------------
-- DiffusionInit Tracer
--------------------------------------------------------------------------------

severityDiffusionInit :: ND.InitializationTracer rard ladr -> SeverityS
severityDiffusionInit :: InitializationTracer rard ladr -> SeverityS
severityDiffusionInit ND.RunServer {}                         = SeverityS
Info
severityDiffusionInit ND.RunLocalServer {}                    = SeverityS
Info
severityDiffusionInit ND.UsingSystemdSocket {}                = SeverityS
Info
severityDiffusionInit ND.CreateSystemdSocketForSnocketPath {} = SeverityS
Info
severityDiffusionInit ND.CreatedLocalSocket {}                = SeverityS
Info
severityDiffusionInit ND.ConfiguringLocalSocket {}            = SeverityS
Info
severityDiffusionInit ND.ListeningLocalSocket {}              = SeverityS
Info
severityDiffusionInit ND.LocalSocketUp  {}                    = SeverityS
Info
severityDiffusionInit ND.CreatingServerSocket {}              = SeverityS
Info
severityDiffusionInit ND.ConfiguringServerSocket {}           = SeverityS
Info
severityDiffusionInit ND.ListeningServerSocket {}             = SeverityS
Info
severityDiffusionInit ND.ServerSocketUp {}                    = SeverityS
Info
severityDiffusionInit ND.UnsupportedLocalSystemdSocket {}     = SeverityS
Info
severityDiffusionInit ND.UnsupportedReadySocketCase {}        = SeverityS
Info
severityDiffusionInit ND.DiffusionErrored {}                  = SeverityS
Info

namesForDiffusionInit  :: ND.InitializationTracer rard ladr -> [Text]
namesForDiffusionInit :: InitializationTracer rard ladr -> [Text]
namesForDiffusionInit  ND.RunServer {}                         =
  [Text
"RunServer"]
namesForDiffusionInit  ND.RunLocalServer {}                    =
  [Text
"RunLocalServer"]
namesForDiffusionInit  ND.UsingSystemdSocket {}                =
  [Text
"UsingSystemdSocket"]
namesForDiffusionInit  ND.CreateSystemdSocketForSnocketPath {} =
  [Text
"CreateSystemdSocketForSnocketPath"]
namesForDiffusionInit  ND.CreatedLocalSocket {}                =
  [Text
"CreatedLocalSocket"]
namesForDiffusionInit  ND.ConfiguringLocalSocket {}            =
  [Text
"ConfiguringLocalSocket"]
namesForDiffusionInit  ND.ListeningLocalSocket {}              =
  [Text
"ListeningLocalSocket"]
namesForDiffusionInit  ND.LocalSocketUp  {}                    =
  [Text
"LocalSocketUp"]
namesForDiffusionInit  ND.CreatingServerSocket {}              =
  [Text
"CreatingServerSocket"]
namesForDiffusionInit  ND.ConfiguringServerSocket {}           =
  [Text
"ConfiguringServerSocket"]
namesForDiffusionInit  ND.ListeningServerSocket {}             =
  [Text
"ListeningServerSocket"]
namesForDiffusionInit  ND.ServerSocketUp {}                    =
  [Text
"ServerSocketUp"]
namesForDiffusionInit  ND.UnsupportedLocalSystemdSocket {}     =
  [Text
"UnsupportedLocalSystemdSocket"]
namesForDiffusionInit  ND.UnsupportedReadySocketCase {}        =
  [Text
"UnsupportedReadySocketCase"]
namesForDiffusionInit  ND.DiffusionErrored {}                  =
  [Text
"DiffusionErrored"]

instance (Show ntnAddr, Show ntcAddr) =>
  LogFormatting (ND.InitializationTracer ntnAddr ntcAddr)  where
  forMachine :: DetailLevel -> InitializationTracer ntnAddr ntcAddr -> Object
forMachine DetailLevel
_dtal (ND.RunServer NonEmpty ntnAddr
sockAddr) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"RunServer"
    , Key
"socketAddress" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (NonEmpty ntnAddr -> String
forall a. Show a => a -> String
show NonEmpty ntnAddr
sockAddr))
    ]

  forMachine DetailLevel
_dtal (ND.RunLocalServer ntcAddr
localAddress) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"RunLocalServer"
    , Key
"localAddress" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (ntcAddr -> String
forall a. Show a => a -> String
show ntcAddr
localAddress))
    ]
  forMachine DetailLevel
_dtal (ND.UsingSystemdSocket ntcAddr
localAddress) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UsingSystemdSocket"
    , Key
"path" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> (ntcAddr -> String) -> ntcAddr -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ntcAddr -> String
forall a. Show a => a -> String
show (ntcAddr -> Text) -> ntcAddr -> Text
forall a b. (a -> b) -> a -> b
$ ntcAddr
localAddress)
    ]

  forMachine DetailLevel
_dtal (ND.CreateSystemdSocketForSnocketPath ntcAddr
localAddress) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CreateSystemdSocketForSnocketPath"
    , Key
"path" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> (ntcAddr -> String) -> ntcAddr -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ntcAddr -> String
forall a. Show a => a -> String
show (ntcAddr -> Text) -> ntcAddr -> Text
forall a b. (a -> b) -> a -> b
$ ntcAddr
localAddress)
    ]
  forMachine DetailLevel
_dtal (ND.CreatedLocalSocket ntcAddr
localAddress) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CreatedLocalSocket"
    , Key
"path" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> (ntcAddr -> String) -> ntcAddr -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ntcAddr -> String
forall a. Show a => a -> String
show (ntcAddr -> Text) -> ntcAddr -> Text
forall a b. (a -> b) -> a -> b
$ ntcAddr
localAddress)
    ]
  forMachine DetailLevel
_dtal (ND.ConfiguringLocalSocket ntcAddr
localAddress FileDescriptor
socket) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ConfiguringLocalSocket"
    , Key
"path" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> (ntcAddr -> String) -> ntcAddr -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ntcAddr -> String
forall a. Show a => a -> String
show (ntcAddr -> Text) -> ntcAddr -> Text
forall a b. (a -> b) -> a -> b
$ ntcAddr
localAddress)
    , Key
"socket" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (FileDescriptor -> String
forall a. Show a => a -> String
show FileDescriptor
socket))
    ]
  forMachine DetailLevel
_dtal (ND.ListeningLocalSocket ntcAddr
localAddress FileDescriptor
socket) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ListeningLocalSocket"
    , Key
"path" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=  Text -> Value
String (String -> Text
pack (String -> Text) -> (ntcAddr -> String) -> ntcAddr -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ntcAddr -> String
forall a. Show a => a -> String
show (ntcAddr -> Text) -> ntcAddr -> Text
forall a b. (a -> b) -> a -> b
$ ntcAddr
localAddress)
    , Key
"socket" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (FileDescriptor -> String
forall a. Show a => a -> String
show FileDescriptor
socket))
    ]
  forMachine DetailLevel
_dtal (ND.LocalSocketUp ntcAddr
localAddress FileDescriptor
fd) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"LocalSocketUp"
    , Key
"path" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (String -> Text) -> (ntcAddr -> String) -> ntcAddr -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ntcAddr -> String
forall a. Show a => a -> String
show (ntcAddr -> Text) -> ntcAddr -> Text
forall a b. (a -> b) -> a -> b
$ ntcAddr
localAddress)
    , Key
"socket" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (FileDescriptor -> String
forall a. Show a => a -> String
show FileDescriptor
fd))
    ]
  forMachine DetailLevel
_dtal (ND.CreatingServerSocket ntnAddr
socket) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"CreatingServerSocket"
    , Key
"socket" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (ntnAddr -> String
forall a. Show a => a -> String
show ntnAddr
socket))
    ]
  forMachine DetailLevel
_dtal (ND.ListeningServerSocket ntnAddr
socket) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ListeningServerSocket"
    , Key
"socket" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (ntnAddr -> String
forall a. Show a => a -> String
show ntnAddr
socket))
    ]
  forMachine DetailLevel
_dtal (ND.ServerSocketUp ntnAddr
socket) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ServerSocketUp"
    , Key
"socket" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (ntnAddr -> String
forall a. Show a => a -> String
show ntnAddr
socket))
    ]
  forMachine DetailLevel
_dtal (ND.ConfiguringServerSocket ntnAddr
socket) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ConfiguringServerSocket"
    , Key
"socket" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (ntnAddr -> String
forall a. Show a => a -> String
show ntnAddr
socket))
    ]
  forMachine DetailLevel
_dtal (ND.UnsupportedLocalSystemdSocket ntnAddr
path) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnsupportedLocalSystemdSocket"
    , Key
"path" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (ntnAddr -> String
forall a. Show a => a -> String
show ntnAddr
path))
    ]
  forMachine DetailLevel
_dtal InitializationTracer ntnAddr ntcAddr
ND.UnsupportedReadySocketCase = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UnsupportedReadySocketCase"
    ]
  forMachine DetailLevel
_dtal (ND.DiffusionErrored SomeException
exception) = [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
    [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"DiffusionErrored"
    , Key
"path" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
exception))
    ]

docDiffusionInit :: Documented (ND.InitializationTracer Socket.SockAddr NtC.LocalAddress)
docDiffusionInit :: Documented (InitializationTracer RemoteAddress LocalAddress)
docDiffusionInit =  [Text]
-> Documented (InitializationTracer RemoteAddress LocalAddress)
-> Documented (InitializationTracer RemoteAddress LocalAddress)
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace  [] Documented (InitializationTracer RemoteAddress LocalAddress)
docDiffusionInit'

docDiffusionInit' :: Documented (ND.InitializationTracer Socket.SockAddr NtC.LocalAddress)
docDiffusionInit' :: Documented (InitializationTracer RemoteAddress LocalAddress)
docDiffusionInit' = [DocMsg (InitializationTracer RemoteAddress LocalAddress)]
-> Documented (InitializationTracer RemoteAddress LocalAddress)
forall a. [DocMsg a] -> Documented a
Documented [
    [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"RunServer"]
      []
      Text
"RunServer "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"RunLocalServer"]
      []
      Text
"RunLocalServer "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
     [Text
"UsingSystemdSocket"]
      []
      Text
"UsingSystemdSocket "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
     [Text
"CreateSystemdSocketForSnocketPath"]
      []
      Text
"CreateSystemdSocketForSnocketPath "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"CreatedLocalSocket"]
      []
      Text
"CreatedLocalSocket "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ConfiguringLocalSocket"]
      []
      Text
"ConfiguringLocalSocket "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ListeningLocalSocket"]
      []
      Text
"ListeningLocalSocket "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"LocalSocketUp"]
      []
      Text
"LocalSocketUp "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"CreatingServerSocket"]
      []
      Text
"CreatingServerSocket "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ConfiguringServerSocket"]
      []
      Text
"ConfiguringServerSocket "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ListeningServerSocket"]
      []
      Text
"ListeningServerSocket "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ServerSocketUp"]
      []
      Text
"ServerSocketUp "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"UnsupportedLocalSystemdSocket"]
      []
      Text
"UnsupportedLocalSystemdSocket "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"UnsupportedReadySocketCase"]
      []
      Text
"UnsupportedReadySocketCase "
  , [Text]
-> [(Text, Text)]
-> Text
-> DocMsg (InitializationTracer RemoteAddress LocalAddress)
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"DiffusionErrored"]
      []
      Text
"DiffusionErrored "
  ]

--------------------------------------------------------------------------------
-- LedgerPeers Tracer
--------------------------------------------------------------------------------

severityLedgerPeers :: TraceLedgerPeers -> SeverityS
severityLedgerPeers :: TraceLedgerPeers -> SeverityS
severityLedgerPeers PickedPeer {}                  = SeverityS
Debug
severityLedgerPeers PickedPeers {}                 = SeverityS
Info
severityLedgerPeers FetchingNewLedgerState {}      = SeverityS
Info
severityLedgerPeers DisabledLedgerPeers {}         = SeverityS
Info
severityLedgerPeers TraceUseLedgerAfter {}         = SeverityS
Info
severityLedgerPeers WaitingOnRequest {}            = SeverityS
Debug
severityLedgerPeers RequestForPeers {}             = SeverityS
Debug
severityLedgerPeers ReusingLedgerState {}          = SeverityS
Debug
severityLedgerPeers FallingBackToBootstrapPeers {} = SeverityS
Info

namesForLedgerPeers :: TraceLedgerPeers -> [Text]
namesForLedgerPeers :: TraceLedgerPeers -> [Text]
namesForLedgerPeers PickedPeer {}                  = [Text
"PickedPeer"]
namesForLedgerPeers PickedPeers {}                 = [Text
"PickedPeers"]
namesForLedgerPeers FetchingNewLedgerState {}      = [Text
"FetchingNewLedgerState"]
namesForLedgerPeers DisabledLedgerPeers {}         = [Text
"DisabledLedgerPeers"]
namesForLedgerPeers TraceUseLedgerAfter {}         = [Text
"TraceUseLedgerAfter"]
namesForLedgerPeers WaitingOnRequest {}            = [Text
"WaitingOnRequest"]
namesForLedgerPeers RequestForPeers {}             = [Text
"RequestForPeers"]
namesForLedgerPeers ReusingLedgerState {}          = [Text
"ReusingLedgerState"]
namesForLedgerPeers FallingBackToBootstrapPeers {} = [Text
"FallingBackToBootstrapPeers"]


instance LogFormatting TraceLedgerPeers where
  forMachine :: DetailLevel -> TraceLedgerPeers -> Object
forMachine DetailLevel
_dtal (PickedPeer RelayAccessPoint
addr AccPoolStake
_ackStake PoolStake
stake) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PickedPeer"
      , Key
"address" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RelayAccessPoint -> String
forall a. Show a => a -> String
show RelayAccessPoint
addr
      , Key
"relativeStake" Key -> Double -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (PoolStake -> Rational
unPoolStake PoolStake
stake) :: Double)
      ]
  forMachine DetailLevel
_dtal (PickedPeers (NumberOfPeers Word16
n) [RelayAccessPoint]
addrs) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"PickedPeers"
      , Key
"desiredCount" Key -> Word16 -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word16
n
      , Key
"count" Key -> Int -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [RelayAccessPoint] -> Int
forall a. HasLength a => a -> Int
length [RelayAccessPoint]
addrs
      , Key
"addresses" Key -> String -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [RelayAccessPoint] -> String
forall a. Show a => a -> String
show [RelayAccessPoint]
addrs
      ]
  forMachine DetailLevel
_dtal (FetchingNewLedgerState Int
cnt) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"FetchingNewLedgerState"
      , Key
"numberOfPools" Key -> Int -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
cnt
      ]
  forMachine DetailLevel
_dtal TraceLedgerPeers
DisabledLedgerPeers =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"DisabledLedgerPeers"
      ]
  forMachine DetailLevel
_dtal (TraceUseLedgerAfter UseLedgerAfter
ula) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"UseLedgerAfter"
      , Key
"useLedgerAfter" Key -> UseLedger -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UseLedgerAfter -> UseLedger
UseLedger UseLedgerAfter
ula
      ]
  forMachine DetailLevel
_dtal TraceLedgerPeers
WaitingOnRequest =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"WaitingOnRequest"
      ]
  forMachine DetailLevel
_dtal (RequestForPeers (NumberOfPeers Word16
np)) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"RequestForPeers"
      , Key
"numberOfPeers" Key -> Word16 -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word16
np
      ]
  forMachine DetailLevel
_dtal (ReusingLedgerState Int
cnt DiffTime
age) =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ReusingLedgerState"
      , Key
"numberOfPools" Key -> Int -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
cnt
      , Key
"ledgerStateAge" Key -> DiffTime -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DiffTime
age
      ]
  forMachine DetailLevel
_dtal TraceLedgerPeers
FallingBackToBootstrapPeers =
    [Object] -> Object
forall a. Monoid a => [a] -> a
mconcat
      [ Key
"kind" Key -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"FallingBackToBootstrapPeers"
      ]

docLedgerPeers :: Documented TraceLedgerPeers
docLedgerPeers :: Documented TraceLedgerPeers
docLedgerPeers =  [Text]
-> Documented TraceLedgerPeers -> Documented TraceLedgerPeers
forall a b. [Text] -> Documented a -> Documented b
addDocumentedNamespace  [] Documented TraceLedgerPeers
docLedgerPeers'

docLedgerPeers' :: Documented TraceLedgerPeers
docLedgerPeers' :: Documented TraceLedgerPeers
docLedgerPeers' = [DocMsg TraceLedgerPeers] -> Documented TraceLedgerPeers
forall a. [DocMsg a] -> Documented a
Documented [
    [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"PickedPeer"]
      []
      Text
"Trace for a peer picked with accumulated and relative stake of its pool."
  , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"PickedPeers"]
      []
      Text
"Trace for the number of peers we wanted to pick and the list of peers picked."
  , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"FetchingNewLedgerState"]
      []
      Text
"Trace for fetching a new list of peers from the ledger. Int is the number of peers\
      \ returned."
  , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"DisabledLedgerPeers"]
      []
      Text
"Trace for when getting peers from the ledger is disabled, that is DontUseLedger."
  , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"TraceUseLedgerAfter"]
      []
      Text
"Trace UseLedgerAfter value."
  , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"WaitingOnRequest"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"RequestForPeers"]
      []
      Text
"RequestForPeers (NumberOfPeers 1)"
  , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"ReusingLedgerState"]
      []
      Text
""
  , [Text] -> [(Text, Text)] -> Text -> DocMsg TraceLedgerPeers
forall a. [Text] -> [(Text, Text)] -> Text -> DocMsg a
DocMsg
      [Text
"FallingBackToBootstrapPeers"]
      []
      Text
""
  ]