diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,22 @@ +2025-02-04 Laurent P. René de Cotret 0.3.3 + +* Removed unused dependencies and addressed some compilation warnings (#467). + +2024-09-03 Laurent P. René de Cotret 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 0.3.1 + +* Now tested with GHC 9.10.1. +* Updated dependency bounds. + +2024-03-27 Laurent P. René de Cotret 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 0.2.4 * Update dependency bounds to build with ghc-8.2.1. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/distributed-process-simplelocalnet.cabal b/distributed-process-simplelocalnet.cabal --- a/distributed-process-simplelocalnet.cabal +++ b/distributed-process-simplelocalnet.cabal @@ -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 +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 diff --git a/src/Control/Distributed/Process/Backend/SimpleLocalnet.hs b/src/Control/Distributed/Process/Backend/SimpleLocalnet.hs --- a/src/Control/Distributed/Process/Backend/SimpleLocalnet.hs +++ b/src/Control/Distributed/Process/Backend/SimpleLocalnet.hs @@ -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 () diff --git a/src/Control/Distributed/Process/Backend/SimpleLocalnet/Internal/Multicast.hs b/src/Control/Distributed/Process/Backend/SimpleLocalnet/Internal/Multicast.hs --- a/src/Control/Distributed/Process/Backend/SimpleLocalnet/Internal/Multicast.hs +++ b/src/Control/Distributed/Process/Backend/SimpleLocalnet/Internal/Multicast.hs @@ -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 diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -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) + + diff --git a/tests/TestSimpleLocalnet.hs b/tests/TestSimpleLocalnet.hs deleted file mode 100644 --- a/tests/TestSimpleLocalnet.hs +++ /dev/null @@ -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"