@@ -226,6 +226,7 @@ import Control.Distributed.Process.Internal.Messaging
226226 )
227227import Control.Distributed.Process.Management.Internal.Types
228228 ( MxEvent(..)
229+ , Destination(..)
229230 )
230231import Control.Distributed.Process.Management.Internal.Trace.Types
231232 ( traceEvent
@@ -256,14 +257,16 @@ send them msg = do
256257 case destNode == nodeId of
257258 True -> sendLocal them msg
258259 False -> liftIO $ sendMessage (processNode proc)
259− (ProcessIdentifier (processId proc))
260− (ProcessIdentifier them)
261− NoImplicitReconnect
262− msg
263− -- We do not fire the trace event until after the sending is complete;
264− -- In the remote case, 'sendMessage' can block in the networking stack.
260+ (ProcessIdentifier (processId proc))
261+ (ProcessIdentifier them)
262+ NoImplicitReconnect
263+ msg
264+ -- see note [trace MxSent]
265265 liftIO $ traceEvent (localEventBus node)
266− (MxSent them us (createUnencodedMessage msg))
266+ MxSent { whichProcess = us
267+ , whereTo = ProcId them
268+ , message = (createUnencodedMessage msg)
269+ }
267270
268271-- | /Unsafe/ variant of 'send'. This function makes /no/ attempt to serialize
269272-- and (in the case when the destination process resides on the same local
@@ -283,12 +286,22 @@ unsafeSend = Unsafe.send
283286--
284287usend :: Serializable a => ProcessId -> a -> Process ()
285288usend them msg = do
286− here <- getSelfNode
287− let there = processNodeId them
288− if here == there
289+ proc <- ask
290+ let us = processId proc
291+ node = processNode proc
292+ nodeId = localNodeId node
293+ let destNodeId = processNodeId them
294+ if nodeId == destNodeId
289295 then sendLocal them msg
290− else sendCtrlMsg (Just there) $ UnreliableSend (processLocalId them)
291− (createMessage msg)
296+ else do -- see note [trace MxSent]
297+ let evBus = localEventBus node
298+ let msg' = createMessage msg
299+ sendCtrlMsg (Just destNodeId) $ UnreliableSend (processLocalId them) msg'
300+ liftIO $ traceEvent evBus $ MxSent { whichProcess = us
301+ , whereTo = ProcId them
302+ , message = msg'
303+ }
304+
292305
293306-- | /Unsafe/ variant of 'usend'. This function makes /no/ attempt to serialize
294307-- the message when the destination process resides on the same local
@@ -487,10 +500,12 @@ forward msg them = do
487500 (ProcessIdentifier them)
488501 NoImplicitReconnect
489502 (messageToPayload msg)
490− -- We do not fire the trace event until after the sending is complete;
491− -- In the remote case, 'sendMessage' can block in the networking stack.
503+
492504 liftIO $ traceEvent (localEventBus node)
493− (MxSent them us msg)
505+ MxSent { whichProcess = us
506+ , whereTo = ProcId them
507+ , message = msg
508+ }
494509
495510-- | Forward a raw 'Message' to the given 'ProcessId'.
496511--
@@ -511,7 +526,10 @@ uforward msg them = do
511526 -- We do not fire the trace event until after the sending is complete;
512527 -- In the remote case, 'sendCtrlMsg' can block in the networking stack.
513528 liftIO $ traceEvent (localEventBus node)
514− (MxSent them us msg)
529+ MxSent { whichProcess = us
530+ , whereTo = ProcId them
531+ , message = msg
532+ }
515533
516534-- | Wrap a 'Serializable' value in a 'Message'. Note that 'Message's are
517535-- 'Serializable' - like the datum they contain - but also note, deserialising
@@ -1220,8 +1238,20 @@ whereisRemoteAsync nid label = do
12201238
12211239-- | Named send to a process in the local registry (asynchronous)
12221240nsend :: Serializable a => String -> a -> Process ()
1223−nsend label msg =
1224− sendCtrlMsg Nothing (NamedSend label (createUnencodedMessage msg))
1241+nsend label msg = do
1242+ proc <- ask
1243+ let us = processId proc
1244+ node = processNode proc
1245+ msg' = createMessage msg -- NB: using UnencodedMessage here causes chaos... :/
1246+
1247+ sendCtrlMsg Nothing (NamedSend label msg')
1248+
1249+ -- see note [trace MxSent]
1250+ liftIO $ traceEvent (localEventBus node)
1251+ MxSent { whichProcess = us
1252+ , whereTo = ProcName label
1253+ , message = msg'
1254+ }
12251255
12261256-- | Named send to a process in the local registry (asynchronous).
12271257-- This function makes /no/ attempt to serialize and (in the case when the
@@ -1233,9 +1263,19 @@ unsafeNSend = Unsafe.nsend
12331263-- | Named send to a process in a remote registry (asynchronous)
12341264nsendRemote :: Serializable a => NodeId -> String -> a -> Process ()
12351265nsendRemote nid label msg = do
1266+ proc <- ask
1267+ let us = processId proc
1268+ node = processNode proc
12361269 here <- getSelfNode
12371270 if here == nid then nsend label msg
1238− else sendCtrlMsg (Just nid) (NamedSend label (createMessage msg))
1271+ else do let msg' = createMessage msg
1272+ sendCtrlMsg (Just nid) (NamedSend label msg')
1273+ -- see note [trace MxSent]
1274+ liftIO $ traceEvent (localEventBus node)
1275+ MxSent { whichProcess = us
1276+ , whereTo = ProcName label
1277+ , message = msg'
1278+ }
12391279
12401280-- | Named send to a process in a remote registry (asynchronous)
12411281-- This function makes /no/ attempt to serialize and (in the case when the
@@ -1306,8 +1346,18 @@ reconnectPort them = do
13061346--------------------------------------------------------------------------------
13071347
13081348sendLocal :: (Serializable a) => ProcessId -> a -> Process ()
1309−sendLocal to msg =
1310− sendCtrlMsg Nothing $ LocalSend to (createUnencodedMessage msg)
1349+sendLocal to msg = do
1350+ proc <- ask
1351+ let us = processId proc
1352+ node = processNode proc
1353+ msg' = createUnencodedMessage msg
1354+
1355+ sendCtrlMsg Nothing $ LocalSend to msg'
1356+ liftIO $ traceEvent (localEventBus node)
1357+ MxSent { whichProcess = us
1358+ , whereTo = ProcId to
1359+ , message = msg'
1360+ }
13111361
13121362sendChanLocal :: (Serializable a) => SendPortId -> a -> Process ()
13131363sendChanLocal spId msg =