distributed-process-simplelocalnet 0.2.4 → 0.3.3
raw patch · 7 files changed
Files
- ChangeLog +19/−0
- Setup.hs +0/−2
- distributed-process-simplelocalnet.cabal +43/−49
- 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,22 @@+2025-02-04 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.3.3++* Removed unused dependencies and addressed some compilation warnings (#467).++2024-09-03 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.3.2++* Bumped dependency bounds to support GHC 8.10.7 - GHC 9.10.1+* Updated links to point to Distributed Haskell monorepo++2024-08-28 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.3.1++* Now tested with GHC 9.10.1.+* Updated dependency bounds.++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.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
distributed-process-simplelocalnet.cabal view
@@ -1,73 +1,67 @@+cabal-version: 3.0 Name: distributed-process-simplelocalnet-Version: 0.2.4-Cabal-Version: >=1.8+Version: 0.3.3 Build-Type: Simple-License: BSD3+License: BSD-3-Clause 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/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==8.10.7 GHC==9.0.2 GHC==9.2.8 GHC==9.4.5 GHC==9.6.4 GHC==9.8.2 GHC==9.10.1 GHC==9.12.1 Category: Control-extra-source-files: ChangeLog+extra-doc-files: ChangeLog -Source-Repository head+source-repository head Type: git- Location: https://github.com/haskell-distributed/distributed-process-simplelocalnet+ Location: https://github.com/haskell-distributed/distributed-process+ SubDir: packages/distributed-process-simplelocalnet -Flag build-example- Default: False- Description: Build a simple example application+common warnings+ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -fhide-source-paths+ -Wpartial-fields+ -Wunused-packages Library- Build-Depends: base >= 4.4 && < 5,- bytestring >= 0.9 && < 0.11,- network >= 2.3 && < 2.7,- network-multicast >= 0.1.1 && < 0.3,+ import: warnings+ Build-Depends: base >= 4.14 && < 5,+ bytestring >= 0.10 && < 0.13,+ exceptions >= 0.10 && <0.11,+ network >= 3.0 && < 3.3,+ 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,+ binary >= 0.8 && < 0.9,+ containers >= 0.6 && < 0.8,+ 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- ghc-options: -Wall+ Default-Language: Haskell2010 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+ import: warnings+ 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.Node (initRemoteTable)+import Control.Distributed.Process.Backend.SimpleLocalnet+import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO)+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"