Skip to content

Commit 464b8a5

Browse files
fmastefmaste
committed
ouroboros-network:framework-logging
1 parent 28caa06 commit 464b8a5

File tree

7 files changed

+1338
-0
lines changed

7 files changed

+1338
-0
lines changed

‎ouroboros-network/framework/cardano-logging/Ouroboros/Network/Logging/Framework.hs‎

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

‎ouroboros-network/framework/cardano-logging/Ouroboros/Network/Logging/Framework/ConnectionId.hs‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE PackageImports #-}
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)