git.iko.soy/distributed-process
on 8aed555 help sign in
448 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 , withMonitor_
106 , MonitorRef -- opaque
107 , ProcessLinkException(..)
108 , NodeLinkException(..)
109 , PortLinkException(..)
110 , ProcessMonitorNotification(..)
111 , NodeMonitorNotification(..)
112 , PortMonitorNotification(..)
113 , DiedReason(..)
114 -- * Closures
115 , Closure
116 , closure
117 , Static
118 , unStatic
119 , unClosure
120 , RemoteTable
121 -- * Logging
122 , say
123 -- * Registry
124 , register
125 , reregister
126 , unregister
127 , whereis
128 , nsend
129 , registerRemoteAsync
130 , reregisterRemoteAsync
131 , unregisterRemoteAsync
132 , whereisRemoteAsync
133 , nsendRemote
134 , WhereIsReply(..)
135 , RegisterReply(..)
136 -- * Exception handling
137 , catch
138 , Handler(..)
139 , catches
140 , try
141 , mask
142 , mask_
143 , onException
144 , bracket
145 , bracket_
146 , finally
147 -- * Auxiliary API
148 , spawnAsync
149 , spawnSupervised
150 , spawnLink
151 , spawnMonitor
152 , spawnChannel
153 , DidSpawn(..)
154 -- * Local versions of 'spawn'
155 , spawnLocal
156 , spawnChannelLocal
157 , callLocal
158 -- * Reconnecting
159 , reconnect
160 , reconnectPort
161 ) where
163import Control.Monad.IO.Class (liftIO)
164import Control.Applicative
165import Control.Monad.Reader (ask)
166import Control.Concurrent (killThread)
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 , localProcessWithId
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 , unsafeNSendRemote
220 -- Advanced messaging
221 , Match
222 , receiveWait
223 , receiveTimeout
224 , match
225 , matchIf
226 , matchUnknown
227 , matchAny
228 , matchAnyIf
229 , matchChan
230 , matchSTM
231 , matchMessage
232 , matchMessageIf
233 , isEncoded
234 , wrapMessage
235 , unsafeWrapMessage
236 , unwrapMessage
237 , handleMessage
238 , handleMessageIf
239 , handleMessage_
240 , handleMessageIf_
241 , forward
242 , uforward
243 , delegate
244 , relay
245 , proxy
246 -- Process management
247 , terminate
248 , ProcessTerminationException(..)
249 , die
250 , exit
251 , catchExit
252 , catchesExit
253 , kill
254 , getSelfPid
255 , getSelfNode
256 , ProcessInfo(..)
257 , getProcessInfo
258 , NodeStats(..)
259 , getNodeStats
260 , getLocalNodeStats
261 -- Monitoring and linking
262 , link
263 , linkNode
264 , linkPort
265 , unlink
266 , unlinkNode
267 , unlinkPort
268 , monitor
269 , monitorNode
270 , monitorPort
271 , unmonitor
272 , withMonitor
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.Types
311 ( processThread
312 , withValidLocalState
313 )
314import Control.Distributed.Process.Internal.Spawn
315 ( -- Spawning Processes/Channels
316 spawn
317 , spawnLink
318 , spawnMonitor
319 , spawnChannel
320 , spawnSupervised
321 , call
322 )
323import qualified Control.Monad.Catch as Catch
325#if MIN_VERSION_base(4,6,0)
326import Prelude
327#else
328import Prelude hiding (catch)
329#endif
330import Control.Distributed.Process.Internal.StrictMVar (readMVar)
331import qualified Control.Exception as Exception (onException)
332import Data.Accessor ((^.))
333import Data.Foldable (forM_)
336-- INTERNAL NOTES
337--
338-- 1. 'send' never fails. If you want to know that the remote process received
339-- your message, you will need to send an explicit acknowledgement. If you
340-- want to know when the remote process failed, you will need to monitor
341-- that remote process.
342--
343-- 2. 'send' may block (when the system TCP buffers are full, while we are
344-- trying to establish a connection to the remote endpoint, etc.) but its
345-- return does not imply that the remote process received the message (much
346-- less processed it). When 'send' targets a local process, it is dispatched
347-- via the node controller however, in which cases it will /not/ block. This
348-- isn't part of the semantics, so it should be ok. The ordering is maintained
349-- because the ctrlChannel still has FIFO semantics with regards interactions
350-- between two disparate forkIO threads.
351--
352-- 3. Message delivery is reliable and ordered. That means that if process A
353-- sends messages m1, m2, m3 to process B, B will either arrive all three
354-- messages in order (m1, m2, m3) or a prefix thereof; messages will not be
355-- 'missing' (m1, m3) or reordered (m1, m3, m2)
356--
357-- In order to guarantee (3), we stipulate that
358--
359-- 3a. We do not garbage collect connections because Network.Transport provides
360-- ordering guarantees only *per connection*.
361--
362-- 3b. Once a connection breaks, we have no way of knowing which messages
363-- arrived and which did not; hence, once a connection fails, we assume the
364-- remote process to be forever unreachable. Otherwise we might sent m1 and
365-- m2, get notified of the broken connection, reconnect, send m3, but only
366-- m1 and m3 arrive.
367--
368-- 3c. As a consequence of (3b) we should not reuse PIDs. If a process dies,
369-- we consider it forever unreachable. Hence, new processes should get new
370-- IDs or they too would be considered unreachable.
371--
372-- Main reference for Cloud Haskell is
373--
374-- [1] "Towards Haskell in the Cloud", Jeff Epstein, Andrew Black and Simon
375-- Peyton-Jones.
376-- http://research.microsoft.com/en-us/um/people/simonpj/papers/parallel/remote.pdf
377--
378-- The precise semantics for message passing is based on
379--
380-- [2] "A Unified Semantics for Future Erlang", Hans Svensson, Lars-Ake Fredlund
381-- and Clara Benac Earle (not freely available online, unfortunately)
382--
383-- Some pointers to related documentation about Erlang, for comparison and
384-- inspiration:
385--
386-- [3] "Programming Distributed Erlang Applications: Pitfalls and Recipes",
387-- Hans Svensson and Lars-Ake Fredlund
388-- http://man.lupaworld.com/content/develop/p37-svensson.pdf
389-- [4] The Erlang manual, sections "Message Sending" and "Send"
390-- http://www.erlang.org/doc/reference_manual/processes.html#id82409
391-- http://www.erlang.org/doc/reference_manual/expressions.html#send
392-- [5] Questions "Is the order of message reception guaranteed?" and
393-- "If I send a message, is it guaranteed to reach the receiver?" of
394-- the Erlang FAQ
395-- http://www.erlang.org/faq/academic.html
396-- [6] "Delivery of Messages", post on erlang-questions
397-- http://erlang.org/pipermail/erlang-questions/2012-February/064767.html
399--------------------------------------------------------------------------------
400-- Local versions of spawn --
401--------------------------------------------------------------------------------
403-- | Spawn a process on the local node
404spawnLocal :: Process () -> Process ProcessId
405spawnLocal proc = do
406 node <- processNode <$> ask
407 liftIO $ forkProcess node proc
409-- | Create a new typed channel, spawn a process on the local node, passing it
410-- the receive port, and return the send port
411spawnChannelLocal :: Serializable a
412 => (ReceivePort a -> Process ())
413 -> Process (SendPort a)
414spawnChannelLocal proc = do
415 node <- processNode <$> ask
416 liftIO $ do
417 mvar <- newEmptyMVar
418 _ <- forkProcess node $ do
419 -- It is important that we allocate the new channel in the new process,
420 -- because otherwise it will be associated with the wrong process ID
421 (sport, rport) <- newChan
422 liftIO $ putMVar mvar sport
423 proc rport
424 takeMVar mvar
426-- | Local version of 'call'. Running a process in this way isolates it from
427-- messages sent to the caller process, and also allows silently dropping late
428-- or duplicate messages sent to the isolated process after it exits.
429-- Silently dropping messages may not always be the best approach.
430callLocal :: Process a -> Process a
431callLocal proc = Catch.mask $ \release -> do
432 mv <- liftIO newEmptyMVar :: Process (MVar (Either Catch.SomeException a))
433 child <- spawnLocal $ Catch.try (release proc) >>= liftIO . putMVar mv
434 lproc <- ask
435 liftIO $ do
436 rs <- Exception.onException (takeMVar mv) $ Catch.uninterruptibleMask_ $
437 -- Exceptions need to be prevented from interrupting the clean up or
438 -- the original exception which caused entering the handler could be
439 -- forgotten. For instance, this could have a problematic effect
440 -- when the original exception was meant to kill the thread and the
441 -- second exception doesn't (like the exception thrown by
442 -- 'System.Timeout.timeout').
443 do mchildThreadId <- withValidLocalState (processNode lproc) $
444 \vst -> return $ fmap processThread $
445 vst ^. localProcessWithId (processLocalId child)
446 forM_ mchildThreadId killThread
447 takeMVar mv
448 either Catch.throwM return rs