@@ -0,0 +1,39 @@
1+-- | Like Latency, but creating lots of channels
2+import System.Environment
3+import Control.Monad
4+import Control.Applicative
5+import Control.Distributed.Process
6+import Control.Distributed.Process.Node
7+import Network.Transport.TCP (createTransport, defaultTCPParameters)
8+import Data.Binary (encode, decode)
9+import qualified Data.ByteString.Lazy as BSL
10+
11+pingServer :: Process ()
12+pingServer = forever $ do
13+ them <- expect
14+ sendChan them ()
15+
16+pingClient :: Int -> ProcessId -> Process ()
17+pingClient n them = do
18+ replicateM_ n $ do
19+ (sc, rc) <- newChan :: Process (SendPort (), ReceivePort ())
20+ send them sc
21+ receiveChan rc
22+ liftIO . putStrLn $ "Did " ++ show n ++ " pings"
23+
24+initialProcess :: String -> Process ()
25+initialProcess "SERVER" = do
26+ us <- getSelfPid
27+ liftIO $ BSL.writeFile "pingServer.pid" (encode us)
28+ pingServer
29+initialProcess "CLIENT" = do
30+ n <- liftIO $ getLine
31+ them <- liftIO $ decode <$> BSL.readFile "pingServer.pid"
32+ pingClient (read n) them
33+
34+main :: IO ()
35+main = do
36+ [role, host, port] <- getArgs
37+ Right transport <- createTransport host port defaultTCPParameters
38+ node <- newLocalNode transport initRemoteTable
39+ runProcess node $ initialProcess role