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