@@ -1,9 +1,8 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+
13-- | Tracing/Debugging support - Types
24module Control.Distributed.Process.Management.Trace.Types
3− ( MxEventBus(..)
4− , MxEvent(..)
5− , SetTrace(..)
6− , Addressable(..)
5+ ( SetTrace(..)
76 , TraceSubject(..)
87 , TraceFlags(..)
98 , TraceArg(..)
@@ -27,6 +26,7 @@ import Control.Applicative ((<$>), (<*>))
2726import Control.Distributed.Process.Internal.CQueue (enqueue)
2827import Control.Distributed.Process.Internal.Types
2928 ( MxEventBus(..)
29+ , Tracer(..)
3030 , NodeId
3131 , ProcessId
3232 , DiedReason
@@ -35,7 +35,11 @@ import Control.Distributed.Process.Internal.Types
3535 , unsafeCreateUnencodedMessage
3636 )
3737import Control.Distributed.Process.Management.Bus
38− ( publishEvent
38+ ( enqueueEvent
39+ )
40+import Control.Distributed.Process.Management.Types
41+ ( MxEvent(..)
42+ , Addressable(..)
3943 )
4044import Control.Distributed.Process.Serializable
4145import Data.Binary
@@ -44,6 +48,7 @@ import Data.List (intersperse)
4448import Data.Set (Set)
4549import qualified Data.Set as Set (fromList)
4650import Data.Typeable
51+import GHC.Generics
4752import System.Mem.Weak (deRefWeak)
4853import Network.Transport
4954 ( ConnectionId
@@ -55,51 +60,8 @@ import Network.Transport
5560--------------------------------------------------------------------------------
5661
5762data SetTrace = TraceEnable !ProcessId | TraceDisable
58− deriving (Typeable, Eq, Show)
59−
60−-- TODO: MOVE the whole Trace namespace into C.D.Process.Management
61−
62−-- | An event that is fired when something /interesting/ happens.
63−-- Trace events are forwarded to a trace listener process, of which
64−-- at most one can be registered per-node.
65−data MxEvent =
66− MxSpawned ProcessId
67− -- ^ fired whenever a local process is spawned
68− | MxRegistered ProcessId String
69− -- ^ fired whenever a process/name is registered (locally)
70− | MxUnRegistered ProcessId String
71− -- ^ fired whenever a process/name is unregistered (locally)
72− | MxProcessDied ProcessId DiedReason
73− -- ^ fired whenever a process dies
74− | MxNodeDied NodeId DiedReason
75− -- ^ fired whenever a node /dies/ (i.e., the connection is broken/disconnected)
76− | MxSent ProcessId ProcessId Message
77− -- ^ fired whenever a message is sent from a local process
78− | MxReceived ProcessId Message
79− -- ^ fired whenever a message is received by a local process
80− | MxConnected ConnectionId EndPointAddress
81− -- ^ fired when a network-transport connection is first established
82− | MxDisconnected ConnectionId EndPointAddress
83− -- ^ fired when a network-transport connection is broken/disconnected
84− | MxUser Message
85− -- ^ a user defined trace event (see 'traceMessage')
86− | MxLog String
87− -- ^ a /logging/ event - used for debugging purposes only
88− | MxTraceTakeover ProcessId
89− -- ^ notifies a trace listener that all subsequent traces will be sent to /pid/
90− | MxTraceDisable
91− -- ^ notifies a trace listener that it has been disabled/removed
92− deriving (Typeable, Show)
93−
94−class Addressable a where
95− resolveToPid :: a -> Maybe ProcessId
96−
97−instance Addressable MxEvent where
98− resolveToPid (MxSpawned p) = Just p
99− resolveToPid (MxProcessDied p _) = Just p
100− resolveToPid (MxSent _ p _) = Just p
101− resolveToPid (MxReceived p _) = Just p
102− resolveToPid _ = Nothing
63+ deriving (Typeable, Generic, Eq, Show)
64+instance Binary SetTrace where
10365
10466-- | Defines which processes will be traced by a given 'TraceFlag',
10567-- either by name, or @ProcessId@. Choosing @TraceAll@ is /by far/
@@ -110,7 +72,8 @@ data TraceSubject =
11072 TraceAll -- enable tracing for all running processes
11173 | TraceProcs !(Set ProcessId) -- enable tracing for a set of processes
11274 | TraceNames !(Set String) -- enable tracing for a set of named/registered processes
113− deriving (Show)
75+ deriving (Typeable, Generic, Show)
76+instance Binary TraceSubject where
11477
11578-- | Defines /what/ will be traced. Flags that control tracing of
11679-- @Process@ events, take a 'TraceSubject' controlling which processes
@@ -124,7 +87,8 @@ data TraceFlags = TraceFlags {
12487 , traceRecv :: !(Maybe TraceSubject) -- filter process/message tracing by receiver
12588 , traceNodes :: !Bool -- enable node status trace events
12689 , traceConnections :: !Bool -- enable connection status trace events
127− } deriving (Typeable, Show)
90+ } deriving (Typeable, Generic, Show)
91+instance Binary TraceFlags where
12892
12993defaultTraceFlags :: TraceFlags
13094defaultTraceFlags =
@@ -145,16 +109,17 @@ data TraceArg =
145109
146110-- | A generic 'ok' response from the trace coordinator.
147111data TraceOk = TraceOk
148− deriving (Typeable)
112+ deriving (Typeable, Generic)
113+instance Binary TraceOk where
149114
150115--------------------------------------------------------------------------------
151116-- Internal/Common API --
152117--------------------------------------------------------------------------------
153118
154−traceLog :: MxEventBus -> String -> IO ()
155−traceLog tr s = publishEvent tr (unsafeCreateUnencodedMessage $ MxLog s)
119+traceLog :: Tracer -> String -> IO ()
120+traceLog (Tracer _ wqRef) s = enqueueEvent wqRef (unsafeCreateUnencodedMessage $ MxLog s)
156121
157−traceLogFmt :: MxEventBus
122+traceLogFmt :: Tracer
158123 -> String
159124 -> [TraceArg]
160125 -> IO ()
@@ -164,43 +129,43 @@ traceLogFmt t d ls =
164129 toS (TraceStr s) = s
165130 toS (Trace a) = show a
166131
167−traceEvent :: MxEventBus -> MxEvent -> IO ()
168−traceEvent tr ev = publishEvent tr (unsafeCreateUnencodedMessage ev)
132+traceEvent :: Tracer -> MxEvent -> IO ()
133+traceEvent (Tracer _ wqRef) ev = enqueueEvent wqRef (unsafeCreateUnencodedMessage ev)
169134
170−traceMessage :: Serializable m => MxEventBus -> m -> IO ()
135+traceMessage :: Serializable m => Tracer -> m -> IO ()
171136traceMessage tr msg = traceEvent tr (MxUser (unsafeCreateUnencodedMessage msg))
172137
173−enableTrace :: MxEventBus -> ProcessId -> IO ()
174−enableTrace t p =
175− publishEvent t (unsafeCreateUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)),
176− (TraceEnable p)))
138+enableTrace :: Tracer -> ProcessId -> IO ()
139+enableTrace (Tracer _ wqRef) p =
140+ enqueueEvent wqRef (unsafeCreateUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)),
141+ (TraceEnable p)))
177142
178−enableTraceSync :: MxEventBus -> SendPort TraceOk -> ProcessId -> IO ()
179−enableTraceSync t s p =
180− publishEvent t (unsafeCreateUnencodedMessage (Just s, TraceEnable p))
143+enableTraceSync :: Tracer -> SendPort TraceOk -> ProcessId -> IO ()
144+enableTraceSync (Tracer _ wqRef) s p =
145+ enqueueEvent wqRef (unsafeCreateUnencodedMessage (Just s, TraceEnable p))
181146
182−disableTrace :: MxEventBus -> IO ()
183−disableTrace t =
184− publishEvent t (unsafeCreateUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)),
147+disableTrace :: Tracer -> IO ()
148+disableTrace (Tracer _ wqRef) =
149+ enqueueEvent wqRef (unsafeCreateUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)),
185150 TraceDisable))
186151
187−disableTraceSync :: MxEventBus -> SendPort TraceOk -> IO ()
188−disableTraceSync t s =
189− publishEvent t (unsafeCreateUnencodedMessage ((Just s), TraceDisable))
152+disableTraceSync :: Tracer -> SendPort TraceOk -> IO ()
153+disableTraceSync (Tracer _ wqRef) s =
154+ enqueueEvent wqRef (unsafeCreateUnencodedMessage ((Just s), TraceDisable))
190155
191−setTraceFlags :: MxEventBus -> TraceFlags -> IO ()
192−setTraceFlags t f =
193− publishEvent t (unsafeCreateUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)), f))
156+setTraceFlags :: Tracer -> TraceFlags -> IO ()
157+setTraceFlags (Tracer _ wqRef) f =
158+ enqueueEvent wqRef (unsafeCreateUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)), f))
194159
195−setTraceFlagsSync :: MxEventBus -> SendPort TraceOk -> TraceFlags -> IO ()
196−setTraceFlagsSync t s f =
197− publishEvent t (unsafeCreateUnencodedMessage ((Just s), f))
160+setTraceFlagsSync :: Tracer -> SendPort TraceOk -> TraceFlags -> IO ()
161+setTraceFlagsSync (Tracer _ wqRef) s f =
162+ enqueueEvent wqRef (unsafeCreateUnencodedMessage ((Just s), f))
198163
199−getTraceFlags :: MxEventBus -> SendPort TraceFlags -> IO ()
200−getTraceFlags t s = publishEvent t (unsafeCreateUnencodedMessage s)
164+getTraceFlags :: Tracer -> SendPort TraceFlags -> IO ()
165+getTraceFlags (Tracer _ wqRef) s = enqueueEvent wqRef (unsafeCreateUnencodedMessage s)
201166
202−getCurrentTraceClient :: MxEventBus -> SendPort (Maybe ProcessId) -> IO ()
203−getCurrentTraceClient t s = publishEvent t (unsafeCreateUnencodedMessage s)
167+getCurrentTraceClient :: Tracer -> SendPort (Maybe ProcessId) -> IO ()
168+getCurrentTraceClient (Tracer _ wqRef) s = enqueueEvent wqRef (unsafeCreateUnencodedMessage s)
204169
205170class Traceable a where
206171 uod :: [a] -> TraceSubject
@@ -211,74 +176,3 @@ instance Traceable ProcessId where
211176instance Traceable String where
212177 uod = TraceNames . Set.fromList
213178
214−--------------------------------------------------------------------------------
215−-- Binary Instances --
216−--------------------------------------------------------------------------------
217−
218−instance Binary SetTrace where
219− put (TraceEnable pid) = putWord8 1 >> put pid
220− put TraceDisable = putWord8 2
221−
222− get = do
223− header <- getWord8
224− case header of
225− 1 -> TraceEnable <$> get
226− 2 -> return TraceDisable
227− _ -> error "SetTrace.get - invalid header"
228−
229−instance Binary MxEvent where
230− put (MxSpawned pid) = putWord8 1 >> put pid
231− put (MxRegistered pid str) = putWord8 2 >> put pid >> put str
232− put (MxUnRegistered pid str) = putWord8 3 >> put pid >> put str
233− put (MxProcessDied pid res) = putWord8 4 >> put pid >> put res
234− put (MxNodeDied nid res) = putWord8 5 >> put nid >> put res
235− put (MxSent to from msg) = putWord8 6 >> put to >> put from >> put msg
236− put (MxReceived pid msg) = putWord8 7 >> put pid >> put msg
237− put (MxConnected cid epid) = putWord8 8 >> put cid >> put epid
238− put (MxDisconnected cid epid) = putWord8 9 >> put cid >> put epid
239− put (MxUser msg) = putWord8 10 >> put msg
240− put (MxLog msg) = putWord8 11 >> put msg
241− put (MxTraceTakeover pid) = putWord8 12 >> put pid
242− put MxTraceDisable = putWord8 13
243−
244− get = do
245− header <- getWord8
246− case header of
247− 1 -> MxSpawned <$> get
248− 2 -> MxRegistered <$> get <*> get
249− 3 -> MxUnRegistered <$> get <*> get
250− 4 -> MxProcessDied <$> get <*> get
251− 5 -> MxNodeDied <$> get <*> get
252− 6 -> MxSent <$> get <*> get <*> get
253− 7 -> MxReceived <$> get <*> get
254− 8 -> MxConnected <$> get <*> get
255− 9 -> MxDisconnected <$> get <*> get
256− 10 -> MxUser <$> get
257− 11 -> MxLog <$> get
258− 12 -> MxTraceTakeover <$> get
259− 13 -> return MxTraceDisable
260− _ -> error "MxEvent.get - invalid header"
261−
262−instance Binary TraceSubject where
263− put TraceAll = putWord8 1
264− put (TraceProcs pids) = putWord8 2 >> put pids
265− put (TraceNames names) = putWord8 3 >> put names
266−
267− get = do
268− header <- getWord8
269− case header of
270− 1 -> return TraceAll
271− 2 -> TraceProcs <$> get
272− 3 -> TraceNames <$> get
273− _ -> error "TraceSubject.get - invalid header"
274−
275−instance Binary TraceFlags where
276− put (TraceFlags s d g u m r n c) =
277− put s >> put d >> put g >> put u >> put m >> put r >> put n >> put c
278− get =
279− TraceFlags <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
280−
281−instance Binary TraceOk where
282− put _ = return ()
283− get = return TraceOk
284−