Skip to content

Commit 19b0584

Browse files
jutarojutaro
committed
Fixes
1 parent a7008ec commit 19b0584

File tree

9 files changed

+106
-49
lines changed

9 files changed

+106
-49
lines changed

‎cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs

Lines changed: 13 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -6,46 +6,40 @@ module Cardano.Tracer.Acceptors.Client
66

77
import Cardano.Logging (TraceObject)
88
import qualified Cardano.Logging.Types as Net
9-
import Cardano.Logging.Version (ForwardingVersion (..), ForwardingVersionData (..),
10-
forwardingCodecCBORTerm, forwardingVersionCodec)
11-
#if RTVIEW
12-
import Cardano.Tracer.Acceptors.Utils (notifyAboutNodeDisconnected,
13-
prepareDataPointRequestor, prepareMetricsStores, removeDisconnectedNode)
14-
#else
15-
import Cardano.Tracer.Acceptors.Utils (
16-
prepareDataPointRequestor, prepareMetricsStores, removeDisconnectedNode)
17-
#endif
9+
import Cardano.Tracer.Acceptors.Utils (prepareDataPointRequestor, prepareMetricsStores,
10+
removeDisconnectedNode)
1811
import qualified Cardano.Tracer.Configuration as TC
1912
import Cardano.Tracer.Environment
2013
import Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler)
2114
import Cardano.Tracer.MetaTrace
2215
import Cardano.Tracer.Utils (connIdToNodeId)
23-
import qualified Network.Mux as Mux
2416
import Ouroboros.Network.Context (MinimalInitiatorContext (..), ResponderContext (..))
2517
import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits)
2618
import Ouroboros.Network.IOManager (withIOManager)
2719
import Ouroboros.Network.Magic (NetworkMagic (..))
2820
import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (..),
2921
MiniProtocolNum (..), OuroborosApplication (..),
30-
RunMiniProtocol (..), miniProtocolLimits, miniProtocolNum, miniProtocolRun,
31-
OuroborosApplicationWithMinimalCtx)
22+
OuroborosApplicationWithMinimalCtx, RunMiniProtocol (..), miniProtocolLimits,
23+
miniProtocolNum, miniProtocolRun)
3224
import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec,
33-
codecHandshake, timeLimitsHandshake, noTimeLimitsHandshake)
25+
codecHandshake, noTimeLimitsHandshake, timeLimitsHandshake)
3426
import Ouroboros.Network.Protocol.Handshake.Type (Handshake)
3527
import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion,
3628
simpleSingletonVersions)
3729
import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket,
38-
localAddressFromPath, localSnocket, socketSnocket, makeSocketBearer, makeLocalBearer)
39-
import Ouroboros.Network.Socket (ConnectionId (..), ConnectToArgs (..),
30+
localAddressFromPath, localSnocket, makeLocalBearer, makeSocketBearer,
31+
socketSnocket)
32+
import Ouroboros.Network.Socket (ConnectToArgs (..), ConnectionId (..),
4033
HandshakeCallbacks (..), connectToNode, nullNetworkConnectTracers)
4134

4235
import Codec.CBOR.Term (Term)
4336
import Control.Exception (throwIO)
4437
import qualified Data.ByteString.Lazy as LBS
45-
import Data.List.NonEmpty (NonEmpty((:|)))
46-
import Data.Void (Void, absurd)
38+
import Data.List.NonEmpty (NonEmpty ((:|)))
4739
import qualified Data.Text as Text
40+
import Data.Void (Void, absurd)
4841
import Data.Word (Word32)
42+
import qualified Network.Mux as Mux
4943
import qualified Network.Socket as Socket
5044
import qualified System.Metrics.Configuration as EKGF
5145
import System.Metrics.Network.Acceptor (acceptEKGMetricsInit)
@@ -54,6 +48,8 @@ import qualified Trace.Forward.Configuration.DataPoint as DPF
5448
import qualified Trace.Forward.Configuration.TraceObject as TF
5549
import Trace.Forward.Run.DataPoint.Acceptor (acceptDataPointsInit)
5650
import Trace.Forward.Run.TraceObject.Acceptor (acceptTraceObjectsInit)
51+
import Trace.Forward.Utils.Version (ForwardingVersion (..), ForwardingVersionData (..),
52+
forwardingCodecCBORTerm, forwardingVersionCodec)
5753

5854
runAcceptorsClient
5955
:: TracerEnv

‎cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs

Lines changed: 8 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -6,48 +6,42 @@ module Cardano.Tracer.Acceptors.Server
66

77
import Cardano.Logging (TraceObject)
88
import qualified Cardano.Logging.Types as Net
9-
import Cardano.Logging.Version (ForwardingVersion (..), ForwardingVersionData (..),
10-
forwardingCodecCBORTerm, forwardingVersionCodec)
11-
#if RTVIEW
12-
import Cardano.Tracer.Acceptors.Utils (notifyAboutNodeDisconnected,
13-
prepareDataPointRequestor, prepareMetricsStores, removeDisconnectedNode)
14-
#else
159
import Cardano.Tracer.Acceptors.Utils (prepareDataPointRequestor, prepareMetricsStores,
1610
removeDisconnectedNode)
17-
#endif
1811
import qualified Cardano.Tracer.Configuration as TC
1912
import Cardano.Tracer.Environment
2013
import Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler)
2114
import Cardano.Tracer.MetaTrace
2215
import Cardano.Tracer.Utils (connIdToNodeId)
23-
import qualified Network.Mux as Mux
2416
import Ouroboros.Network.Context (MinimalInitiatorContext (..), ResponderContext (..))
2517
import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits)
2618
import Ouroboros.Network.ErrorPolicy (nullErrorPolicies)
2719
import Ouroboros.Network.IOManager (withIOManager)
2820
import Ouroboros.Network.Magic (NetworkMagic (..))
2921
import Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolLimits (..),
3022
MiniProtocolNum (..), OuroborosApplication (..),
31-
RunMiniProtocol (..), OuroborosApplicationWithMinimalCtx,
32-
miniProtocolLimits, miniProtocolNum, miniProtocolRun)
23+
OuroborosApplicationWithMinimalCtx, RunMiniProtocol (..), miniProtocolLimits,
24+
miniProtocolNum, miniProtocolRun)
3325
import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionDataCodec,
3426
codecHandshake, noTimeLimitsHandshake, timeLimitsHandshake)
3527
import Ouroboros.Network.Protocol.Handshake.Type (Handshake)
3628
import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion,
3729
simpleSingletonVersions)
3830
import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket,
39-
localAddressFromPath, localSnocket, socketSnocket, makeSocketBearer, makeLocalBearer)
31+
localAddressFromPath, localSnocket, makeLocalBearer, makeSocketBearer,
32+
socketSnocket)
4033
import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectionId (..),
4134
HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState,
4235
newNetworkMutableState, nullNetworkServerTracers, withServerNode)
4336

4437
import Codec.CBOR.Term (Term)
4538
import Control.Concurrent.Async (race_, wait)
4639
import qualified Data.ByteString.Lazy as LBS
47-
import Data.List.NonEmpty (NonEmpty((:|)))
40+
import Data.List.NonEmpty (NonEmpty ((:|)))
4841
import qualified Data.Text as Text
4942
import Data.Void (Void)
5043
import Data.Word (Word32)
44+
import qualified Network.Mux as Mux
5145
import qualified Network.Socket as Socket
5246
import qualified System.Metrics.Configuration as EKGF
5347
import System.Metrics.Network.Acceptor (acceptEKGMetricsResp)
@@ -56,6 +50,8 @@ import qualified Trace.Forward.Configuration.DataPoint as DPF
5650
import qualified Trace.Forward.Configuration.TraceObject as TF
5751
import Trace.Forward.Run.DataPoint.Acceptor (acceptDataPointsResp)
5852
import Trace.Forward.Run.TraceObject.Acceptor (acceptTraceObjectsResp)
53+
import Trace.Forward.Utils.Version (ForwardingVersion (..), ForwardingVersionData (..),
54+
forwardingCodecCBORTerm, forwardingVersionCodec)
5955

6056

6157
runAcceptorsServer

‎cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,6 @@ module Cardano.Tracer.Test.Forwarder
1818
import Cardano.Logging (DetailLevel (..), SeverityS (..), TraceObject (..))
1919
import Cardano.Logging.Types (HowToConnect)
2020
import qualified Cardano.Logging.Types as Net
21-
import Cardano.Logging.Version (ForwardingVersion (..), ForwardingVersionData (..),
22-
forwardingCodecCBORTerm, forwardingVersionCodec)
2321
import Cardano.Tracer.Configuration (Verbosity (..))
2422
import Cardano.Tracer.Test.TestSetup
2523
import Cardano.Tracer.Test.Utils
@@ -36,7 +34,7 @@ import Ouroboros.Network.Protocol.Handshake.Type (Handshake)
3634
import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion,
3735
simpleSingletonVersions)
3836
import Ouroboros.Network.Snocket (MakeBearer, Snocket, localAddressFromPath, localSnocket,
39-
makeLocalBearer, socketSnocket, makeSocketBearer)
37+
makeLocalBearer, makeSocketBearer, socketSnocket)
4038
import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToArgs (..),
4139
HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState,
4240
connectToNode, newNetworkMutableState, nullNetworkConnectTracers,
@@ -52,7 +50,7 @@ import "contra-tracer" Control.Tracer (contramap, nullTracer, stdoutTr
5250
import Data.Aeson (FromJSON, ToJSON)
5351
import qualified Data.ByteString.Lazy as LBS
5452
import Data.Foldable (for_)
55-
import Data.List.NonEmpty (NonEmpty((:|)))
53+
import Data.List.NonEmpty (NonEmpty ((:|)))
5654
import qualified Data.Text as Text
5755
import Data.Time.Clock (getCurrentTime)
5856
import Data.Void (Void, absurd)
@@ -70,8 +68,10 @@ import qualified Trace.Forward.Configuration.TraceObject as TOF
7068
import Trace.Forward.Run.DataPoint.Forwarder
7169
import Trace.Forward.Run.TraceObject.Forwarder
7270
import Trace.Forward.Utils.DataPoint
71+
import Trace.Forward.Utils.ForwardSink (ForwardSink)
7372
import Trace.Forward.Utils.TraceObject
74-
import Trace.Forward.Utils.ForwardSink (ForwardSink)
73+
import Trace.Forward.Utils.Version (ForwardingVersion (..), ForwardingVersionData (..),
74+
forwardingCodecCBORTerm, forwardingVersionCodec)
7575

7676
data ForwardersMode = Initiator | Responder
7777

‎trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@
33
{-# LANGUAGE GADTs #-}
44
{-# LANGUAGE RecordWildCards #-}
55
{-# LANGUAGE ScopedTypeVariables #-}
6-
{-# LANGUAGE GADTs #-}
76

87
module Cardano.Logging.Tracer.DataPoint
98
(

‎trace-dispatcher/src/Cardano/Logging/Types.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -60,8 +60,6 @@ module Cardano.Logging.Types (
6060
) where
6161

6262

63-
-- import Ouroboros.Network.Util.ShowProxy (ShowProxy (..))
64-
6563
import Codec.Serialise (Serialise (..))
6664
import qualified Control.Tracer as T
6765
import qualified Data.Aeson as AE

‎trace-forward/src/Trace/Forward/Forwarding.hs

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,11 @@
11
{-# LANGUAGE BlockArguments #-}
22

33
{-# LANGUAGE DataKinds #-}
4-
{-# LANGUAGE ViewPatterns #-}
5-
{-# LANGUAGE TypeApplications #-}
64
{-# LANGUAGE FlexibleInstances #-}
75
{-# LANGUAGE PackageImports #-}
86
{-# LANGUAGE ScopedTypeVariables #-}
7+
{-# LANGUAGE TypeApplications #-}
8+
{-# LANGUAGE ViewPatterns #-}
99

1010
module Trace.Forward.Forwarding
1111
(
@@ -15,7 +15,6 @@ module Trace.Forward.Forwarding
1515

1616
import Cardano.Logging.Types
1717
import Cardano.Logging.Utils (runInLoop)
18-
import Cardano.Logging.Version
1918
import Ouroboros.Network.Driver.Limits (ProtocolTimeLimits)
2019
import Ouroboros.Network.ErrorPolicy (nullErrorPolicies)
2120
import Ouroboros.Network.IOManager (IOManager)
@@ -28,8 +27,9 @@ import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionData
2827
import Ouroboros.Network.Protocol.Handshake.Type (Handshake)
2928
import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion,
3029
simpleSingletonVersions)
31-
import Ouroboros.Network.Snocket (MakeBearer, Snocket, LocalAddress, LocalSocket, localAddressFromPath, localSnocket,
32-
socketSnocket, makeLocalBearer, makeSocketBearer)
30+
import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, MakeBearer, Snocket,
31+
localAddressFromPath, localSnocket, makeLocalBearer, makeSocketBearer,
32+
socketSnocket)
3333
import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectToArgs (..),
3434
HandshakeCallbacks (..), SomeResponderApplication (..), cleanNetworkMutableState,
3535
connectToNode, newNetworkMutableState, nullNetworkConnectTracers,
@@ -59,8 +59,9 @@ import qualified Trace.Forward.Configuration.TraceObject as TF
5959
import Trace.Forward.Run.DataPoint.Forwarder
6060
import Trace.Forward.Run.TraceObject.Forwarder
6161
import Trace.Forward.Utils.DataPoint
62+
import Trace.Forward.Utils.ForwardSink (ForwardSink)
6263
import Trace.Forward.Utils.TraceObject
63-
import Trace.Forward.Utils.ForwardSink (ForwardSink)
64+
import Trace.Forward.Utils.Version
6465

6566
initForwarding :: forall m. (MonadIO m)
6667
=> IOManager

‎trace-forward/src/Trace/Forward/Protocol/TraceObject/Type.hs

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -23,15 +23,16 @@ module Trace.Forward.Protocol.TraceObject.Type
2323
, StBlockingStyle(..)
2424
) where
2525

26+
import Cardano.Logging.Types (TraceObject)
2627
import Ouroboros.Network.Util.ShowProxy (ShowProxy (..))
2728

28-
import Data.Kind (Type)
29-
import Data.Singletons
3029
import Codec.Serialise (Serialise (..))
30+
import Data.Kind (Type)
3131
import Data.List.NonEmpty (NonEmpty)
32+
import Data.Singletons
3233
import Data.Word (Word16)
3334
import GHC.Generics (Generic)
34-
import Network.TypedProtocol.Core -- (Protocol (..))
35+
import Network.TypedProtocol.Core
3536

3637
-- | A kind to identify our protocol, and the types of the states in the state
3738
-- transition diagram of the protocol.
@@ -184,3 +185,5 @@ instance Protocol (TraceObjectForward lo) where
184185

185186
deriving stock
186187
instance Show lo => Show (Message (TraceObjectForward lo) from to)
188+
189+
instance ShowProxy TraceObject

‎trace-forward/src/Trace/Forward/Utils/Version.hs

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
{-# LANGUAGE NamedFieldPuns #-}
2+
3+
module Trace.Forward.Utils.Version
4+
( ForwardingVersion (..)
5+
, ForwardingVersionData (..)
6+
, forwardingVersionCodec
7+
, forwardingCodecCBORTerm
8+
) where
9+
10+
import Ouroboros.Network.CodecCBORTerm
11+
import Ouroboros.Network.Magic
12+
import Ouroboros.Network.Protocol.Handshake.Version (Accept (..), Acceptable (..),
13+
Queryable (..))
14+
15+
import qualified Codec.CBOR.Term as CBOR
16+
import Data.Text (Text)
17+
import qualified Data.Text as T
18+
19+
data ForwardingVersion
20+
= ForwardingV_1
21+
| ForwardingV_2
22+
deriving (Eq, Ord, Enum, Bounded, Show)
23+
24+
forwardingVersionCodec :: CodecCBORTerm (Text, Maybe Int) ForwardingVersion
25+
forwardingVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
26+
where
27+
encodeTerm ForwardingV_1 = CBOR.TInt 1
28+
encodeTerm ForwardingV_2 = CBOR.TInt 2
29+
30+
decodeTerm (CBOR.TInt 1) = Right ForwardingV_1
31+
decodeTerm (CBOR.TInt 2) = Right ForwardingV_2
32+
decodeTerm (CBOR.TInt n) = Left ( T.pack "decode ForwardingVersion: unknown tag: " <> T.pack (show n)
33+
, Just n
34+
)
35+
decodeTerm _ = Left ( T.pack "decode ForwardingVersion: unexpected term"
36+
, Nothing
37+
)
38+
39+
newtype ForwardingVersionData = ForwardingVersionData
40+
{ networkMagic :: NetworkMagic
41+
} deriving (Eq, Show)
42+
43+
instance Acceptable ForwardingVersionData where
44+
acceptableVersion local remote
45+
| local == remote = Accept local
46+
| otherwise = Refuse $ T.pack $ "ForwardingVersionData mismatch: "
47+
++ show local
48+
++ " /= " ++ show remote
49+
50+
instance Queryable ForwardingVersionData where
51+
queryVersion _ = False
52+
53+
forwardingCodecCBORTerm :: ForwardingVersion -> CodecCBORTerm Text ForwardingVersionData
54+
forwardingCodecCBORTerm _ = CodecCBORTerm { encodeTerm, decodeTerm }
55+
where
56+
encodeTerm :: ForwardingVersionData -> CBOR.Term
57+
encodeTerm ForwardingVersionData { networkMagic } =
58+
CBOR.TInt (fromIntegral $ unNetworkMagic networkMagic)
59+
60+
decodeTerm :: CBOR.Term -> Either Text ForwardingVersionData
61+
decodeTerm (CBOR.TInt x) | x >= 0 && x <= 0xffffffff = Right (ForwardingVersionData $ NetworkMagic $ fromIntegral x)
62+
| otherwise = Left $ T.pack $ "networkMagic out of bound: " <> show x
63+
decodeTerm t = Left $ T.pack $ "unknown encoding: " ++ show t

‎trace-forward/trace-forward.cabal

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,7 @@ library
5656
Trace.Forward.Utils.DataPoint
5757
Trace.Forward.Utils.TraceObject
5858
Trace.Forward.Utils.ForwardSink
59+
Trace.Forward.Utils.Version
5960

6061
build-depends: aeson
6162
, async
@@ -65,6 +66,7 @@ library
6566
, contra-tracer
6667
, extra
6768
, io-classes
69+
, network
6870
, network-mux
6971
, ouroboros-network-api
7072
, ekg-core
@@ -73,6 +75,8 @@ library
7375
, ouroboros-network-framework ^>= 0.18.0.1
7476
, serialise
7577
, stm
78+
, text
79+
, trace-dispatcher
7680
, typed-protocols ^>= 0.3
7781
, typed-protocols-cborg
7882
, trace-dispatcher
@@ -88,7 +92,6 @@ test-suite test
8892
Test.Trace.Forward.Protocol.TraceObject.Examples
8993
Test.Trace.Forward.Protocol.TraceObject.Item
9094
Test.Trace.Forward.Protocol.TraceObject.Tests
91-
Trace.Forward.Forwaring
9295

9396
Test.Trace.Forward.Protocol.DataPoint.Codec
9497
Test.Trace.Forward.Protocol.DataPoint.Direct
@@ -112,8 +115,6 @@ test-suite test
112115
, tasty-quickcheck
113116
, typed-protocols
114117
, text
115-
, ekg-core
116-
, ekg-forward
117118

118119
ghc-options: -rtsopts
119120
-threaded

0 commit comments

Comments
 (0)