git.iko.soy/distributed-process
on 87bb129 help sign in
435 lines 11 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.MVar
170 ( MVar
171 , newEmptyMVar
172 , takeMVar
173 , putMVar
174 )
175import Control.Distributed.Static
176 ( Closure
177 , closure
178 , Static
179 , RemoteTable
180 )
181import Control.Distributed.Process.Internal.Types
182 ( NodeId(..)
183 , ProcessId(..)
184 , Process(..)
185 , MonitorRef(..)
186 , ProcessMonitorNotification(..)
187 , NodeMonitorNotification(..)
188 , PortMonitorNotification(..)
189 , ProcessLinkException(..)
190 , NodeLinkException(..)
191 , PortLinkException(..)
192 , ProcessRegistrationException(..)
193 , DiedReason(..)
194 , SpawnRef(..)
195 , DidSpawn(..)
196 , SendPort(..)
197 , ReceivePort(..)
198 , SendPortId(..)
199 , WhereIsReply(..)
200 , RegisterReply(..)
201 , LocalProcess(processNode)
202 , Message
203 )
204import Control.Distributed.Process.Serializable (Serializable)
205import Control.Distributed.Process.Internal.Primitives
206 ( -- Basic messaging
207 send
208 , usend
209 , expect
210 -- Channels
211 , newChan
212 , sendChan
213 , receiveChan
214 , mergePortsBiased
215 , mergePortsRR
216 , unsafeSend
217 , unsafeUSend
218 , unsafeSendChan
219 , unsafeNSend
220 , unsafeNSendRemote
221 -- Advanced messaging
222 , Match
223 , receiveWait
224 , receiveTimeout
225 , match
226 , matchIf
227 , matchUnknown
228 , matchAny
229 , matchAnyIf
230 , matchChan
231 , matchSTM
232 , matchMessage
233 , matchMessageIf
234 , isEncoded
235 , wrapMessage
236 , unsafeWrapMessage
237 , unwrapMessage
238 , handleMessage
239 , handleMessageIf
240 , handleMessage_
241 , handleMessageIf_
242 , forward
243 , uforward
244 , delegate
245 , relay
246 , proxy
247 -- Process management
248 , terminate
249 , ProcessTerminationException(..)
250 , die
251 , exit
252 , catchExit
253 , catchesExit
254 , kill
255 , getSelfPid
256 , getSelfNode
257 , ProcessInfo(..)
258 , getProcessInfo
259 , NodeStats(..)
260 , getNodeStats
261 , getLocalNodeStats
262 -- Monitoring and linking
263 , link
264 , linkNode
265 , linkPort
266 , unlink
267 , unlinkNode
268 , unlinkPort
269 , monitor
270 , monitorNode
271 , monitorPort
272 , unmonitor
273 , withMonitor
274 -- Logging
275 , say
276 -- Registry
277 , register
278 , reregister
279 , unregister
280 , whereis
281 , nsend
282 , registerRemoteAsync
283 , reregisterRemoteAsync
284 , unregisterRemoteAsync
285 , whereisRemoteAsync
286 , nsendRemote
287 -- Closures
288 , unStatic
289 , unClosure
290 -- Exception handling
291 , catch
292 , Handler(..)
293 , catches
294 , try
295 , mask
296 , mask_
297 , onException
298 , bracket
299 , bracket_
300 , finally
301 -- Auxiliary API
302 , expectTimeout
303 , receiveChanTimeout
304 , spawnAsync
305 -- Reconnecting
306 , reconnect
307 , reconnectPort
308 )
309import Control.Distributed.Process.Node (forkProcess)
310import Control.Distributed.Process.Internal.Spawn
311 ( -- Spawning Processes/Channels
312 spawn
313 , spawnLink
314 , spawnMonitor
315 , spawnChannel
316 , spawnSupervised
317 , call
318 )
319import Control.Exception (SomeException, throw)
321-- INTERNAL NOTES
322--
323-- 1. 'send' never fails. If you want to know that the remote process received
324-- your message, you will need to send an explicit acknowledgement. If you
325-- want to know when the remote process failed, you will need to monitor
326-- that remote process.
327--
328-- 2. 'send' may block (when the system TCP buffers are full, while we are
329-- trying to establish a connection to the remote endpoint, etc.) but its
330-- return does not imply that the remote process received the message (much
331-- less processed it). When 'send' targets a local process, it is dispatched
332-- via the node controller however, in which cases it will /not/ block. This
333-- isn't part of the semantics, so it should be ok. The ordering is maintained
334-- because the ctrlChannel still has FIFO semantics with regards interactions
335-- between two disparate forkIO threads.
336--
337-- 3. Message delivery is reliable and ordered. That means that if process A
338-- sends messages m1, m2, m3 to process B, B will either arrive all three
339-- messages in order (m1, m2, m3) or a prefix thereof; messages will not be
340-- 'missing' (m1, m3) or reordered (m1, m3, m2)
341--
342-- In order to guarantee (3), we stipulate that
343--
344-- 3a. We do not garbage collect connections because Network.Transport provides
345-- ordering guarantees only *per connection*.
346--
347-- 3b. Once a connection breaks, we have no way of knowing which messages
348-- arrived and which did not; hence, once a connection fails, we assume the
349-- remote process to be forever unreachable. Otherwise we might sent m1 and
350-- m2, get notified of the broken connection, reconnect, send m3, but only
351-- m1 and m3 arrive.
352--
353-- 3c. As a consequence of (3b) we should not reuse PIDs. If a process dies,
354-- we consider it forever unreachable. Hence, new processes should get new
355-- IDs or they too would be considered unreachable.
356--
357-- Main reference for Cloud Haskell is
358--
359-- [1] "Towards Haskell in the Cloud", Jeff Epstein, Andrew Black and Simon
360-- Peyton-Jones.
361-- http://research.microsoft.com/en-us/um/people/simonpj/papers/parallel/remote.pdf
362--
363-- The precise semantics for message passing is based on
364--
365-- [2] "A Unified Semantics for Future Erlang", Hans Svensson, Lars-Ake Fredlund
366-- and Clara Benac Earle (not freely available online, unfortunately)
367--
368-- Some pointers to related documentation about Erlang, for comparison and
369-- inspiration:
370--
371-- [3] "Programming Distributed Erlang Applications: Pitfalls and Recipes",
372-- Hans Svensson and Lars-Ake Fredlund
373-- http://man.lupaworld.com/content/develop/p37-svensson.pdf
374-- [4] The Erlang manual, sections "Message Sending" and "Send"
375-- http://www.erlang.org/doc/reference_manual/processes.html#id82409
376-- http://www.erlang.org/doc/reference_manual/expressions.html#send
377-- [5] Questions "Is the order of message reception guaranteed?" and
378-- "If I send a message, is it guaranteed to reach the receiver?" of
379-- the Erlang FAQ
380-- http://www.erlang.org/faq/academic.html
381-- [6] "Delivery of Messages", post on erlang-questions
382-- http://erlang.org/pipermail/erlang-questions/2012-February/064767.html
384--------------------------------------------------------------------------------
385-- Local versions of spawn --
386--------------------------------------------------------------------------------
388-- | Spawn a process on the local node
389spawnLocal :: Process () -> Process ProcessId
390spawnLocal proc = do
391 node <- processNode <$> ask
392 liftIO $ forkProcess node proc
394-- | Create a new typed channel, spawn a process on the local node, passing it
395-- the receive port, and return the send port
396spawnChannelLocal :: Serializable a
397 => (ReceivePort a -> Process ())
398 -> Process (SendPort a)
399spawnChannelLocal proc = do
400 node <- processNode <$> ask
401 liftIO $ do
402 mvar <- newEmptyMVar
403 _ <- forkProcess node $ do
404 -- It is important that we allocate the new channel in the new process,
405 -- because otherwise it will be associated with the wrong process ID
406 (sport, rport) <- newChan
407 liftIO $ putMVar mvar sport
408 proc rport
409 takeMVar mvar
411-- | Local version of 'call'. Running a process in this way isolates it from
412-- messages sent to the caller process, and also allows silently dropping late
413-- or duplicate messages sent to the isolated process after it exits.
414-- Silently dropping messages may not always be the best approach.
415callLocal :: Process a -> Process a
416callLocal proc = mask $ \release -> do
417 mv <- liftIO newEmptyMVar :: Process (MVar (Either SomeException a))
418 child <- spawnLocal $ mask_ $ try (release proc) >>= liftIO . putMVar mv
419 ref <- monitor child
420 rs <- liftIO (takeMVar mv)
421 `onException`
422 (do kill child "exception in parent process"
423 waitFor ref
424 )
425 either throw return rs
426 where
427 -- TODO: when processes spawned with spawnLocal inherit the masking state of
428 -- the parent, this can be simplified to simply reading the MVar.
429 --
430 -- At the time of this writing, the spawned process is unmasked and can be
431 -- killed before the MVar is filled.
432 waitFor ref = receiveWait
433 [ matchIf (\(ProcessMonitorNotification ref' _ _) -> ref == ref')
434 (\_ -> return ())
435 ]