git.iko.soy/distributed-process
on caf93de help sign in
443 lines 12 kB history raw
1{-# LANGUAGE CPP #-}
2{- | [Cloud Haskell]
4This is an implementation of Cloud Haskell, as described in
5/Towards Haskell in the Cloud/ by Jeff Epstein, Andrew Black, and Simon
6Peyton Jones (see
7<http://research.microsoft.com/en-us/um/people/simonpj/papers/parallel/>),
8although some of the details are different. The precise message passing
9semantics are based on /A unified semantics for future Erlang/ by Hans
10Svensson, Lars-Åke Fredlund and Clara Benac Earle.
12For a detailed description of the package and other reference materials,
13please see the distributed-process wiki page on github:
14<https://github.com/haskell-distributed/distributed-process/wiki>.
16-}
17module Control.Distributed.Process
18 ( -- * Basic types
19 ProcessId
20 , NodeId(..)
21 , Process
22 , SendPortId
23 , processNodeId
24 , sendPortProcessId
25 , liftIO -- Reexported for convenience
26 -- * Basic messaging
27 , send
28 , usend
29 , expect
30 , expectTimeout
31 -- * Channels
32 , ReceivePort
33 , SendPort
34 , sendPortId
35 , newChan
36 , sendChan
37 , receiveChan
38 , receiveChanTimeout
39 , mergePortsBiased
40 , mergePortsRR
41 -- * Unsafe messaging variants
42 , unsafeSend
43 , unsafeUSend
44 , unsafeSendChan
45 , unsafeNSend
46 , unsafeNSendRemote
47 , unsafeWrapMessage
48 -- * Advanced messaging
49 , Match
50 , receiveWait
51 , receiveTimeout
52 , match
53 , matchIf
54 , matchUnknown
55 , matchAny
56 , matchAnyIf
57 , matchChan
58 , matchSTM
59 , Message
60 , matchMessage
61 , matchMessageIf
62 , isEncoded
63 , wrapMessage
64 , unwrapMessage
65 , handleMessage
66 , handleMessageIf
67 , handleMessage_
68 , handleMessageIf_
69 , forward
70 , uforward
71 , delegate
72 , relay
73 , proxy
74 -- * Process management
75 , spawn
76 , call
77 , terminate
78 , die
79 , kill
80 , exit
81 , catchExit
82 , catchesExit
83 , ProcessTerminationException(..)
84 , ProcessRegistrationException(..)
85 , SpawnRef
86 , getSelfPid
87 , getSelfNode
88 , ProcessInfo(..)
89 , getProcessInfo
90 , NodeStats(..)
91 , getNodeStats
92 , getLocalNodeStats
93 -- * Monitoring and linking
94 , link
95 , linkNode
96 , linkPort
97 , unlink
98 , unlinkNode
99 , unlinkPort
100 , monitor
101 , monitorNode
102 , monitorPort
103 , unmonitor
104 , withMonitor
105 , MonitorRef -- opaque
106 , ProcessLinkException(..)
107 , NodeLinkException(..)
108 , PortLinkException(..)
109 , ProcessMonitorNotification(..)
110 , NodeMonitorNotification(..)
111 , PortMonitorNotification(..)
112 , DiedReason(..)
113 -- * Closures
114 , Closure
115 , closure
116 , Static
117 , unStatic
118 , unClosure
119 , RemoteTable
120 -- * Logging
121 , say
122 -- * Registry
123 , register
124 , reregister
125 , unregister
126 , whereis
127 , nsend
128 , registerRemoteAsync
129 , reregisterRemoteAsync
130 , unregisterRemoteAsync
131 , whereisRemoteAsync
132 , nsendRemote
133 , WhereIsReply(..)
134 , RegisterReply(..)
135 -- * Exception handling
136 , catch
137 , Handler(..)
138 , catches
139 , try
140 , mask
141 , mask_
142 , onException
143 , bracket
144 , bracket_
145 , finally
146 -- * Auxiliary API
147 , spawnAsync
148 , spawnSupervised
149 , spawnLink
150 , spawnMonitor
151 , spawnChannel
152 , DidSpawn(..)
153 -- * Local versions of 'spawn'
154 , spawnLocal
155 , spawnChannelLocal
156 , callLocal
157 -- * Reconnecting
158 , reconnect
159 , reconnectPort
160 ) where
162#if ! MIN_VERSION_base(4,6,0)
163import Prelude hiding (catch)
164#endif
166import Control.Monad.IO.Class (liftIO)
167import Control.Applicative ((<$>))
168import Control.Monad.Reader (ask)
169import Control.Concurrent (killThread)
170import Control.Concurrent.MVar
171 ( MVar
172 , newEmptyMVar
173 , takeMVar
174 , putMVar
175 )
176import Control.Distributed.Static
177 ( Closure
178 , closure
179 , Static
180 , RemoteTable
181 )
182import Control.Distributed.Process.Internal.Types
183 ( NodeId(..)
184 , ProcessId(..)
185 , Process(..)
186 , MonitorRef(..)
187 , ProcessMonitorNotification(..)
188 , NodeMonitorNotification(..)
189 , PortMonitorNotification(..)
190 , ProcessLinkException(..)
191 , NodeLinkException(..)
192 , PortLinkException(..)
193 , ProcessRegistrationException(..)
194 , DiedReason(..)
195 , SpawnRef(..)
196 , DidSpawn(..)
197 , SendPort(..)
198 , ReceivePort(..)
199 , SendPortId(..)
200 , WhereIsReply(..)
201 , RegisterReply(..)
202 , LocalProcess(processNode)
203 , Message
204 , localProcessWithId
205 )
206import Control.Distributed.Process.Serializable (Serializable)
207import Control.Distributed.Process.Internal.Primitives
208 ( -- Basic messaging
209 send
210 , usend
211 , expect
212 -- Channels
213 , newChan
214 , sendChan
215 , receiveChan
216 , mergePortsBiased
217 , mergePortsRR
218 , unsafeSend
219 , unsafeUSend
220 , unsafeSendChan
221 , unsafeNSend
222 , unsafeNSendRemote
223 -- Advanced messaging
224 , Match
225 , receiveWait
226 , receiveTimeout
227 , match
228 , matchIf
229 , matchUnknown
230 , matchAny
231 , matchAnyIf
232 , matchChan
233 , matchSTM
234 , matchMessage
235 , matchMessageIf
236 , isEncoded
237 , wrapMessage
238 , unsafeWrapMessage
239 , unwrapMessage
240 , handleMessage
241 , handleMessageIf
242 , handleMessage_
243 , handleMessageIf_
244 , forward
245 , uforward
246 , delegate
247 , relay
248 , proxy
249 -- Process management
250 , terminate
251 , ProcessTerminationException(..)
252 , die
253 , exit
254 , catchExit
255 , catchesExit
256 , kill
257 , getSelfPid
258 , getSelfNode
259 , ProcessInfo(..)
260 , getProcessInfo
261 , NodeStats(..)
262 , getNodeStats
263 , getLocalNodeStats
264 -- Monitoring and linking
265 , link
266 , linkNode
267 , linkPort
268 , unlink
269 , unlinkNode
270 , unlinkPort
271 , monitor
272 , monitorNode
273 , monitorPort
274 , unmonitor
275 , withMonitor
276 -- Logging
277 , say
278 -- Registry
279 , register
280 , reregister
281 , unregister
282 , whereis
283 , nsend
284 , registerRemoteAsync
285 , reregisterRemoteAsync
286 , unregisterRemoteAsync
287 , whereisRemoteAsync
288 , nsendRemote
289 -- Closures
290 , unStatic
291 , unClosure
292 -- Exception handling
293 , catch
294 , Handler(..)
295 , catches
296 , try
297 , mask
298 , mask_
299 , onException
300 , bracket
301 , bracket_
302 , finally
303 -- Auxiliary API
304 , expectTimeout
305 , receiveChanTimeout
306 , spawnAsync
307 -- Reconnecting
308 , reconnect
309 , reconnectPort
310 )
311import Control.Distributed.Process.Node (forkProcess)
312import Control.Distributed.Process.Internal.Types
313 ( processThread
314 , withValidLocalState
315 )
316import Control.Distributed.Process.Internal.Spawn
317 ( -- Spawning Processes/Channels
318 spawn
319 , spawnLink
320 , spawnMonitor
321 , spawnChannel
322 , spawnSupervised
323 , call
324 )
325import Control.Exception (SomeException, throwIO, uninterruptibleMask_)
326import qualified Control.Exception as Exception (onException)
327import Control.Monad (forM_)
328import Data.Accessor ((^.))
331-- INTERNAL NOTES
332--
333-- 1. 'send' never fails. If you want to know that the remote process received
334-- your message, you will need to send an explicit acknowledgement. If you
335-- want to know when the remote process failed, you will need to monitor
336-- that remote process.
337--
338-- 2. 'send' may block (when the system TCP buffers are full, while we are
339-- trying to establish a connection to the remote endpoint, etc.) but its
340-- return does not imply that the remote process received the message (much
341-- less processed it). When 'send' targets a local process, it is dispatched
342-- via the node controller however, in which cases it will /not/ block. This
343-- isn't part of the semantics, so it should be ok. The ordering is maintained
344-- because the ctrlChannel still has FIFO semantics with regards interactions
345-- between two disparate forkIO threads.
346--
347-- 3. Message delivery is reliable and ordered. That means that if process A
348-- sends messages m1, m2, m3 to process B, B will either arrive all three
349-- messages in order (m1, m2, m3) or a prefix thereof; messages will not be
350-- 'missing' (m1, m3) or reordered (m1, m3, m2)
351--
352-- In order to guarantee (3), we stipulate that
353--
354-- 3a. We do not garbage collect connections because Network.Transport provides
355-- ordering guarantees only *per connection*.
356--
357-- 3b. Once a connection breaks, we have no way of knowing which messages
358-- arrived and which did not; hence, once a connection fails, we assume the
359-- remote process to be forever unreachable. Otherwise we might sent m1 and
360-- m2, get notified of the broken connection, reconnect, send m3, but only
361-- m1 and m3 arrive.
362--
363-- 3c. As a consequence of (3b) we should not reuse PIDs. If a process dies,
364-- we consider it forever unreachable. Hence, new processes should get new
365-- IDs or they too would be considered unreachable.
366--
367-- Main reference for Cloud Haskell is
368--
369-- [1] "Towards Haskell in the Cloud", Jeff Epstein, Andrew Black and Simon
370-- Peyton-Jones.
371-- http://research.microsoft.com/en-us/um/people/simonpj/papers/parallel/remote.pdf
372--
373-- The precise semantics for message passing is based on
374--
375-- [2] "A Unified Semantics for Future Erlang", Hans Svensson, Lars-Ake Fredlund
376-- and Clara Benac Earle (not freely available online, unfortunately)
377--
378-- Some pointers to related documentation about Erlang, for comparison and
379-- inspiration:
380--
381-- [3] "Programming Distributed Erlang Applications: Pitfalls and Recipes",
382-- Hans Svensson and Lars-Ake Fredlund
383-- http://man.lupaworld.com/content/develop/p37-svensson.pdf
384-- [4] The Erlang manual, sections "Message Sending" and "Send"
385-- http://www.erlang.org/doc/reference_manual/processes.html#id82409
386-- http://www.erlang.org/doc/reference_manual/expressions.html#send
387-- [5] Questions "Is the order of message reception guaranteed?" and
388-- "If I send a message, is it guaranteed to reach the receiver?" of
389-- the Erlang FAQ
390-- http://www.erlang.org/faq/academic.html
391-- [6] "Delivery of Messages", post on erlang-questions
392-- http://erlang.org/pipermail/erlang-questions/2012-February/064767.html
394--------------------------------------------------------------------------------
395-- Local versions of spawn --
396--------------------------------------------------------------------------------
398-- | Spawn a process on the local node
399spawnLocal :: Process () -> Process ProcessId
400spawnLocal proc = do
401 node <- processNode <$> ask
402 liftIO $ forkProcess node proc
404-- | Create a new typed channel, spawn a process on the local node, passing it
405-- the receive port, and return the send port
406spawnChannelLocal :: Serializable a
407 => (ReceivePort a -> Process ())
408 -> Process (SendPort a)
409spawnChannelLocal proc = do
410 node <- processNode <$> ask
411 liftIO $ do
412 mvar <- newEmptyMVar
413 _ <- forkProcess node $ do
414 -- It is important that we allocate the new channel in the new process,
415 -- because otherwise it will be associated with the wrong process ID
416 (sport, rport) <- newChan
417 liftIO $ putMVar mvar sport
418 proc rport
419 takeMVar mvar
421-- | Local version of 'call'. Running a process in this way isolates it from
422-- messages sent to the caller process, and also allows silently dropping late
423-- or duplicate messages sent to the isolated process after it exits.
424-- Silently dropping messages may not always be the best approach.
425callLocal :: Process a -> Process a
426callLocal proc = mask $ \release -> do
427 mv <- liftIO newEmptyMVar :: Process (MVar (Either SomeException a))
428 child <- spawnLocal $ try (release proc) >>= liftIO . putMVar mv
429 lproc <- ask
430 liftIO $ do
431 rs <- Exception.onException (takeMVar mv) $ uninterruptibleMask_ $
432 -- Exceptions need to be prevented from interrupting the clean up or
433 -- the original exception which caused entering the handler could be
434 -- forgotten. For instance, this could have a problematic effect
435 -- when the original exception was meant to kill the thread and the
436 -- second exception doesn't (like the exception thrown by
437 -- 'System.Timeout.timeout').
438 do mchildThreadId <- withValidLocalState (processNode lproc) $
439 \vst -> return $ fmap processThread $
440 vst ^. localProcessWithId (processLocalId child)
441 forM_ mchildThreadId killThread
442 takeMVar mv
443 either throwIO return rs