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