distributed-process-simplelocalnet 0.2.4 → 0.3.0
raw patch · 6 files changed
+97/−94 lines, 6 filesdep +distributed-process-simplelocalnetdep +exceptionsdep +tastydep ~basedep ~binarydep ~bytestringnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: distributed-process-simplelocalnet, exceptions, tasty, tasty-hunit
Dependency ranges changed: base, binary, bytestring, containers, distributed-process, network, network-multicast, network-transport-tcp, transformers
API changes (from Hackage documentation)
Files
- ChangeLog +5/−0
- distributed-process-simplelocalnet.cabal +25/−43
- src/Control/Distributed/Process/Backend/SimpleLocalnet.hs +22/−19
- src/Control/Distributed/Process/Backend/SimpleLocalnet/Internal/Multicast.hs +1/−8
- tests/Main.hs +44/−0
- tests/TestSimpleLocalnet.hs +0/−24
ChangeLog view
@@ -1,3 +1,8 @@+2024-03-27 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.3.0++* Breaking change: update dependency bounds to require network-3.0.+* Use various functions from the `exceptions` package instead of the deprecated ones from `distributed-process`.+ 2017-08-22 Facundo Domínguez <facundo.dominguezy@tweag.io> 0.2.4 * Update dependency bounds to build with ghc-8.2.1.
distributed-process-simplelocalnet.cabal view
@@ -1,21 +1,21 @@ Name: distributed-process-simplelocalnet-Version: 0.2.4-Cabal-Version: >=1.8+Version: 0.3.0+Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 License-File: LICENSE Copyright: Well-Typed LLP Author: Duncan Coutts, Nicolas Wu, Edsko de Vries-Maintainer: Facundo Domínguez <facundo.dominguez@tweag.io>+Maintainer: The Distributed Haskell team Stability: experimental Homepage: http://haskell-distributed.github.com-Bug-Reports: https://cloud-haskell.atlassian.net/browse/DPSLN+Bug-Reports: https://github.com/haskell-distributed/distributed-process-simplelocalnet/issues Synopsis: Simple zero-configuration backend for Cloud Haskell Description: Simple backend based on the TCP transport which offers node discovery based on UDP multicast. This is a zero-configuration backend designed to get you going with Cloud Haskell quickly without imposing any structure on your application.-Tested-With: GHC==7.2.2 GHC==7.4.1 GHC==7.4.2+Tested-With: GHC==9.0.2 GHC==9.2.8 GHC==9.4.5 GHC==9.6.4 GHC==9.8.2 Category: Control extra-source-files: ChangeLog @@ -23,51 +23,33 @@ Type: git Location: https://github.com/haskell-distributed/distributed-process-simplelocalnet -Flag build-example- Default: False- Description: Build a simple example application- Library Build-Depends: base >= 4.4 && < 5,- bytestring >= 0.9 && < 0.11,- network >= 2.3 && < 2.7,- network-multicast >= 0.1.1 && < 0.3,+ bytestring >= 0.9 && < 0.12,+ exceptions >= 0.5 && <0.11,+ network >= 3.0 && < 3.2,+ network-multicast >= 0.1.1 && < 0.4, data-accessor >= 0.2 && < 0.3, binary >= 0.6.3 && < 0.9,- containers >= 0.4 && < 0.6,- transformers >= 0.2 && < 0.6,- network-transport >= 0.4.1.0 && < 0.6,- network-transport-tcp >= 0.4 && < 0.7,+ containers >= 0.4 && < 0.8,+ transformers >= 0.2 && < 0.7,+ network-transport >= 0.5 && < 0.6,+ network-transport-tcp >= 0.4 && < 0.9, distributed-process >= 0.5.0 && < 0.8 Exposed-modules: Control.Distributed.Process.Backend.SimpleLocalnet, Control.Distributed.Process.Backend.SimpleLocalnet.Internal.Multicast- Extensions: RankNTypes,- DeriveDataTypeable,- CPP+ Default-Language: Haskell2010 ghc-options: -Wall HS-Source-Dirs: src -Executable TestSimpleLocalnet- Main-Is: TestSimpleLocalnet.hs- Other-Modules:- Control.Distributed.Process.Backend.SimpleLocalnet- Control.Distributed.Process.Backend.SimpleLocalnet.Internal.Multicast- If flag(build-example)- Build-Depends: base >= 4.4 && < 5,- bytestring >= 0.9 && < 0.11,- network >= 2.3 && < 2.7,- network-multicast >= 0.0 && < 0.3,- data-accessor >= 0.2 && < 0.3,- binary >= 0.5 && < 0.9,- containers >= 0.4 && < 0.6,- transformers >= 0.2 && < 0.6,- network-transport >= 0.4.1.0 && < 0.6,- network-transport-tcp >= 0.4 && < 0.7,- distributed-process >= 0.5.0 && < 0.8- Else- Buildable: False- Extensions: RankNTypes,- DeriveDataTypeable,- CPP- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind - HS-Source-Dirs: tests src+Test-Suite SimpleLocalNet-TestSuite+ Type: exitcode-stdio-1.0+ Hs-Source-Dirs: tests+ Main-Is: Main.hs+ Default-Language: Haskell2010+ ghc-options: -threaded -with-rtsopts=-N+ Build-Depends: base+ , distributed-process+ , distributed-process-simplelocalnet+ , tasty+ , tasty-hunit
src/Control/Distributed/Process/Backend/SimpleLocalnet.hs view
@@ -102,9 +102,9 @@ import qualified Data.Set as Set (insert, empty, toList) import Data.Foldable (forM_) import Data.Typeable (Typeable)-import Control.Applicative ((<$>)) import Control.Exception (throw) import Control.Monad (forever, replicateM, replicateM_)+import Control.Monad.Catch (bracket, try, finally) import Control.Monad.IO.Class (liftIO) import Control.Concurrent (forkIO, threadDelay, ThreadId) import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)@@ -129,13 +129,10 @@ , unmonitor , NodeMonitorNotification(..) , ProcessRegistrationException- , finally , newChan , receiveChan , nsend , SendPort- , bracket- , try , send ) import qualified Control.Distributed.Process.Node as Node@@ -147,6 +144,8 @@ import qualified Network.Transport.TCP as NT ( createTransport , defaultTCPParameters+ , TCPAddr(Addressable)+ , TCPAddrInfo(TCPAddrInfo) ) import qualified Network.Transport as NT (Transport) import qualified Network.Socket as N (HostName, ServiceName, SockAddr)@@ -174,7 +173,7 @@ -- | Initialize the backend initializeBackend :: N.HostName -> N.ServiceName -> RemoteTable -> IO Backend initializeBackend host port rtable = do- mTransport <- NT.createTransport host port (\sn -> (host, sn))+ mTransport <- NT.createTransport (NT.Addressable $ NT.TCPAddrInfo host port (\sn -> (host, sn))) NT.defaultTCPParameters (recv, sendp) <- initMulticast "224.0.0.99" 9999 1024 (_, backendState) <- fixIO $ \ ~(tid, _) -> do@@ -256,21 +255,20 @@ myPid <- getSelfPid forM_ mLogger $ \logger -> do-- bracket- (mapM monitor slavecontrollers)- (mapM unmonitor)- $ \_ -> do+ bracket+ (mapM monitor slavecontrollers)+ (mapM unmonitor)+ $ \_ -> do - -- fire off redirect requests- forM_ slavecontrollers $ \pid -> send pid (RedirectLogsTo logger myPid)+ -- fire off redirect requests+ forM_ slavecontrollers $ \pid -> send pid (RedirectLogsTo logger myPid) - -- Wait for the replies- replicateM_ (length slavecontrollers) $ do- receiveWait- [ match (\(RedirectLogsReply {}) -> return ())- , match (\(NodeMonitorNotification {}) -> return ())- ]+ -- Wait for the replies+ replicateM_ (length slavecontrollers) $ do+ receiveWait+ [ match (\(RedirectLogsReply {}) -> return ())+ , match (\(NodeMonitorNotification {}) -> return ())+ ] -------------------------------------------------------------------------------- -- Slaves --@@ -360,9 +358,14 @@ -- Wait for the replies catMaybes <$> replicateM (length nodes) ( receiveWait- [ match (\(WhereIsReply "slaveController" mPid) -> return mPid)+ [ match handleWhereIsReply , match (\(NodeMonitorNotification {}) -> return Nothing) ])+ where+ handleWhereIsReply :: WhereIsReply -> Process (Maybe ProcessId)+ handleWhereIsReply (WhereIsReply name mPid)+ | name == "slaveController" = return mPid+ | otherwise = return Nothing -- | Terminate all slaves terminateAllSlaves :: Backend -> Process ()
src/Control/Distributed/Process/Backend/SimpleLocalnet/Internal/Multicast.hs view
@@ -1,4 +1,5 @@ -- | Multicast utilities+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Control.Distributed.Process.Backend.SimpleLocalnet.Internal.Multicast (initMulticast) where @@ -18,7 +19,6 @@ ) import Data.Accessor (Accessor, (^:), (^.), (^=)) import qualified Data.Accessor.Container as DAC (mapDefault)-import Control.Applicative ((<$>)) import Network.Socket (HostName, PortNumber, Socket, SockAddr) import qualified Network.Socket.ByteString as NBS (recvFrom, sendManyTo) import Network.Transport.Internal (decodeNum32, encodeEnum32)@@ -59,13 +59,6 @@ -------------------------------------------------------------------------------- type UDPState = Map SockAddr BSL.ByteString--#if MIN_VERSION_network(2,4,0)--- network-2.4.0 provides the Ord instance for us-#else-instance Ord SockAddr where- compare = compare `on` show-#endif bufferFor :: SockAddr -> Accessor UDPState BSL.ByteString bufferFor = DAC.mapDefault BSL.empty
+ tests/Main.hs view
@@ -0,0 +1,44 @@+++import Control.Concurrent (forkIO, threadDelay)+import qualified Control.Concurrent.MVar as MVar+import Control.Distributed.Process (NodeId, Process, liftIO)+import Control.Distributed.Process.Node (initRemoteTable)+import Control.Distributed.Process.Backend.SimpleLocalnet+import Control.Monad (forM_)+import qualified Data.List as List+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase)++main :: IO ()+main = defaultMain + $ testGroup "Test suite" + [ testDiscoverNodes+ ]++testDiscoverNodes :: TestTree+testDiscoverNodes = testCase "discover nodes" $ do++ -- Initialize slave nodes+ forM_ ["10000", "10001", "10002", "10003"] $ \port -> do+ backend <- initializeBackend "127.0.0.1" port initRemoteTable+ _ <- forkIO $ startSlave backend+ threadDelay 100000+ + -- initialize master node+ discoveredNodesSlot <- MVar.newEmptyMVar+ backend <- initializeBackend "127.0.0.1" "10004" initRemoteTable+ startMaster backend $ \nds -> do+ terminateAllSlaves backend+ liftIO $ MVar.putMVar discoveredNodesSlot nds++ discoveredNodes <- (List.sort . List.nub) <$> MVar.readMVar discoveredNodesSlot+ assertEqual "Discovered nodes" + [ "nid://127.0.0.1:10000:0"+ , "nid://127.0.0.1:10001:0"+ , "nid://127.0.0.1:10002:0"+ , "nid://127.0.0.1:10003:0"+ ] + (map show discoveredNodes)++
− tests/TestSimpleLocalnet.hs
@@ -1,24 +0,0 @@-import System.Environment (getArgs, getProgName)-import Control.Distributed.Process (NodeId, Process, liftIO)-import Control.Distributed.Process.Node (initRemoteTable)-import Control.Distributed.Process.Backend.SimpleLocalnet--master :: Backend -> [NodeId] -> Process ()-master backend slaves = do- liftIO . putStrLn $ "Slaves: " ++ show slaves- terminateAllSlaves backend--main :: IO ()-main = do- prog <- getProgName- args <- getArgs-- case args of- ["master", host, port] -> do- backend <- initializeBackend host port initRemoteTable- startMaster backend (master backend)- ["slave", host, port] -> do- backend <- initializeBackend host port initRemoteTable- startSlave backend- _ ->- putStrLn $ "usage: " ++ prog ++ " (master | slave) host port"