Skip to content

Commit e3ddb0a

Browse files
committed
ouroboros-network:framework-logging
1 parent 6152689 commit e3ddb0a

File tree

7 files changed

+1276
-0
lines changed

7 files changed

+1276
-0
lines changed
Lines changed: 126 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,126 @@
1+
{-# LANGUAGE FlexibleInstances #-}
2+
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
5+
{-# OPTIONS_GHC -Wno-orphans #-}
6+
7+
module Ouroboros.Network.Logging.Framework () where
8+
9+
import Cardano.Logging
10+
11+
import qualified Ouroboros.Network.Protocol.Handshake.Type as HS
12+
import Ouroboros.Network.Snocket (LocalAddress (..), RemoteAddress)
13+
import Network.TypedProtocol.Codec (AnyMessage (..))
14+
15+
import Data.Aeson (Value (String), (.=))
16+
import qualified Data.IP as IP
17+
import Data.Text (Text, pack)
18+
import Network.Socket (SockAddr (..))
19+
20+
import Ouroboros.Network.Logging.Framework.ConnectionId ()
21+
import Ouroboros.Network.Logging.Framework.ConnectionManager ()
22+
import Ouroboros.Network.Logging.Framework.Driver ()
23+
import Ouroboros.Network.Logging.Framework.InboundGovernor ()
24+
import Ouroboros.Network.Logging.Framework.Server ()
25+
26+
--------------------------------------------------------------------------------
27+
-- Addresses.
28+
--------------------------------------------------------------------------------
29+
30+
-- From `Cardano.Node.Tracing.Tracers.P2P`
31+
-- Branch "ana/10.6-final-integration-mix"
32+
33+
instance LogFormatting LocalAddress where
34+
forMachine _dtal (LocalAddress path) =
35+
mconcat ["path" .= path]
36+
37+
instance LogFormatting RemoteAddress where
38+
forMachine _dtal (SockAddrInet port addr) =
39+
let ip = IP.fromHostAddress addr in
40+
mconcat [ "addr" .= show ip
41+
, "port" .= show port
42+
]
43+
forMachine _dtal (SockAddrInet6 port _ addr _) =
44+
let ip = IP.fromHostAddress6 addr in
45+
mconcat [ "addr" .= show ip
46+
, "port" .= show port
47+
]
48+
forMachine _dtal (SockAddrUnix path) =
49+
mconcat [ "path" .= show path ]
50+
51+
--------------------------------------------------------------------------------
52+
-- Handshake Tracer.
53+
--------------------------------------------------------------------------------
54+
55+
-- From `Cardano.Node.Tracing.Tracers.Diffusion`
56+
-- Branch "ana/10.6-final-integration-mix"
57+
58+
instance (Show term, Show ntcVersion) =>
59+
LogFormatting (AnyMessage (HS.Handshake ntcVersion term)) where
60+
forMachine _dtal (AnyMessageAndAgency stok msg) =
61+
mconcat [ "kind" .= String kind
62+
, "msg" .= (String . showT $ msg)
63+
, "agency" .= String (pack $ show stok)
64+
]
65+
where
66+
kind = case msg of
67+
HS.MsgProposeVersions {} -> "ProposeVersions"
68+
HS.MsgReplyVersions {} -> "ReplyVersions"
69+
HS.MsgQueryReply {} -> "QueryReply"
70+
HS.MsgAcceptVersion {} -> "AcceptVersion"
71+
HS.MsgRefuse {} -> "Refuse"
72+
73+
forHuman (AnyMessageAndAgency stok msg) =
74+
"Handshake (agency, message) = " <> "(" <> showT stok <> "," <> showT msg <> ")"
75+
76+
instance MetaTrace (AnyMessage (HS.Handshake a b)) where
77+
namespaceFor (AnyMessage msg) = Namespace [] $ case msg of
78+
HS.MsgProposeVersions {} -> ["ProposeVersions"]
79+
HS.MsgReplyVersions {} -> ["ReplyVersions"]
80+
HS.MsgQueryReply {} -> ["QueryReply"]
81+
HS.MsgAcceptVersion {} -> ["AcceptVersion"]
82+
HS.MsgRefuse {} -> ["Refuse"]
83+
84+
severityFor (Namespace _ [sym]) _ = case sym of
85+
"ProposeVersions" -> Just Info
86+
"ReplyVersions" -> Just Info
87+
"QueryReply" -> Just Info
88+
"AcceptVersion" -> Just Info
89+
"Refuse" -> Just Info
90+
_otherwise -> Nothing
91+
severityFor _ _ = Nothing
92+
93+
documentFor (Namespace _ sym) = wrap . mconcat $ case sym of
94+
["ProposeVersions"] ->
95+
[ "Propose versions together with version parameters. It must be"
96+
, " encoded to a sorted list.."
97+
]
98+
["ReplyVersions"] ->
99+
[ "`MsgReplyVersions` received as a response to 'MsgProposeVersions'. It"
100+
, " is not supported to explicitly send this message. It can only be"
101+
, " received as a copy of 'MsgProposeVersions' in a simultaneous open"
102+
, " scenario."
103+
]
104+
["QueryReply"] ->
105+
[ "`MsgQueryReply` received as a response to a handshake query in "
106+
, " 'MsgProposeVersions' and lists the supported versions."
107+
]
108+
["AcceptVersion"] ->
109+
[ "The remote end decides which version to use and sends chosen version."
110+
, "The server is allowed to modify version parameters."
111+
]
112+
["Refuse"] -> ["It refuses to run any version."]
113+
_otherwise -> [] :: [Text]
114+
where
115+
wrap it = case it of
116+
"" -> Nothing
117+
it' -> Just it'
118+
119+
allNamespaces = [
120+
Namespace [] ["ProposeVersions"]
121+
, Namespace [] ["ReplyVersions"]
122+
, Namespace [] ["QueryReply"]
123+
, Namespace [] ["AcceptVersion"]
124+
, Namespace [] ["Refuse"]
125+
]
126+
Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
{-# LANGUAGE PackageImports #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
4+
-------------------------------------------------------------------------------
5+
6+
-- Orphan instances module for Cardano tracer.
7+
{-# OPTIONS_GHC -Wno-orphans #-}
8+
-- Extracted from "cardano-node" `Cardano.Node.Tracing.Tracers.Consensus`.
9+
-- Branch "ana/10.6-final-integration-mix"
10+
11+
-------------------------------------------------------------------------------
12+
13+
module Ouroboros.Network.Logging.Framework.ConnectionId () where
14+
15+
-------------------------------------------------------------------------------
16+
17+
---------
18+
-- base -
19+
---------
20+
--
21+
---------------------
22+
-- Package: "aeson" -
23+
---------------------
24+
import "aeson" Data.Aeson (Value (String), (.=))
25+
---------------------------------
26+
-- Package: "ouroboros-network" -
27+
---------------------------------
28+
import "ouroboros-network" -- "ouroboros-newtwork:framework"
29+
Ouroboros.Network.ConnectionId (ConnectionId (..))
30+
------------------------------
31+
-- Package: trace-dispatcher -
32+
------------------------------
33+
import "trace-dispatcher" Cardano.Logging
34+
35+
--------------------------------------------------------------------------------
36+
-- Types instances.
37+
--------------------------------------------------------------------------------
38+
39+
instance (LogFormatting adr, Show adr) => LogFormatting (ConnectionId adr) where
40+
forMachine _dtal (ConnectionId local' remote) =
41+
mconcat [ "connectionId" .= String (showT local'
42+
<> " "
43+
<> showT remote)
44+
]
45+
forHuman (ConnectionId local' remote) =
46+
"ConnectionId " <> showT local' <> " " <> showT remote
47+

0 commit comments

Comments
 (0)