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