git.iko.soy/distributed-process
on master help sign in
Add ping benchmark.
d582957Nicolas Wu
README.md+19
compare with master
unifiedsplit
@@ -83,5 +83,24 @@ with their `SourceAddr`. The master then decodes this, and sends a message
83back. After processing this message, the slaves respond to the master,
83back. After processing this message, the slaves respond to the master,
84which then outputs some data.
84which then outputs some data.
85
85
86+Benchmarks
87+----------
88+
89+The Transport.TCP backend uses Network.ByteString.Lazy as its undelying
90+protocol, so we produce a benchmark that compares it directly with this.
91+Furthermore, the Data.Binary package is used for converting values
92+to ByteStrings for transmission.
93+
94+The benchmarking is performed on the client side using criterion:
95+the server must be set up before benching is performed.
96+
97+### Ping
98+
99+This benchmark measures how quickly a sequence of ping/pong messages
100+are sent between a server and client. Full details can be found in:
101+
102+ ./benchmarks/PingTCP.hs
103+ ./benchmarks/PingTransport.hs
104+
86[1]: http://research.microsoft.com/en-us/um/people/simonpj/papers/parallel/remote.pdf
105[1]: http://research.microsoft.com/en-us/um/people/simonpj/papers/parallel/remote.pdf
87[2]: https://github.com/haskell-distributed/distributed-process/wiki
106[2]: https://github.com/haskell-distributed/distributed-process/wiki
benchmarks/PingTCP.hsnew file+88
@@ -0,0 +1,88 @@
1+module Main where
2+
3+import Control.Monad
4+import Criterion.Main (Benchmark, bench, defaultMain, nfIO, bgroup)
5+import Data.Binary
6+import Data.Int
7+import Network.Socket
8+ ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket
9+ , SocketType (Stream), SocketOption (ReuseAddr)
10+ , accept, addrAddress, addrFlags, addrFamily, bindSocket, defaultProtocol
11+ , defaultHints
12+ , getAddrInfo, listen, setSocketOption, socket, sClose, withSocketsDo )
13+import System.Environment (getArgs, withArgs)
14+
15+import qualified Network.Socket as N
16+import qualified Network.Socket.ByteString.Lazy as NBS
17+
18+import Debug.Trace
19+
20+-- | This performs a ping benchmark on a TCP connection created by
21+-- Network.Socket. To compile this file, you might use:
22+--
23+-- ghc --make -idistributed-process/src -inetwork-transport/src -O2 benchmarks/PingTCP.hs
24+--
25+-- To use the compiled binary, first set up the server on the current machine:
26+--
27+-- ./benchmarks/PingTCP server 8080
28+--
29+-- Next, perform the benchmark on a client using the server address, where
30+-- each mark is 1000 pings:
31+--
32+-- ./benchmarks/PingTCP client 0.0.0.0 8080 1000
33+--
34+-- The server must be restarted between benchmarks.
35+main :: IO ()
36+main = do
37+ args <- getArgs
38+ case args of
39+ "server" : service : [] -> withSocketsDo $ do
40+ putStrLn "server: creating TCP connection"
41+ serverAddrs <- getAddrInfo
42+ (Just (defaultHints { addrFlags = [AI_PASSIVE] } ))
43+ Nothing
44+ (Just service)
45+ let serverAddr = head serverAddrs
46+ sock <- socket (addrFamily serverAddr) Stream defaultProtocol
47+ setSocketOption sock ReuseAddr 1
48+ bindSocket sock (addrAddress serverAddr)
49+
50+ putStrLn "server: awaiting client connection"
51+ listen sock 1
52+ (clientSock, clientAddr) <- accept sock
53+
54+ putStrLn "server: listening for pings"
55+ forever (pong clientSock)
56+
57+ "client": host : service : pingsStr : args' -> withSocketsDo $ do
58+ let pings = read pingsStr
59+ serverAddrs <- getAddrInfo
60+ Nothing
61+ (Just host)
62+ (Just service)
63+ let serverAddr = head serverAddrs
64+ sock <- socket (addrFamily serverAddr) Stream defaultProtocol
65+
66+ N.connect sock (addrAddress serverAddr)
67+
68+ -- benchmark the pings
69+ withArgs args' $ defaultMain [ benchPing sock pings ]
70+
71+-- | Each `ping` sends a single `Int64`, and expects to receive one
72+-- back in return.
73+ping :: Socket -> Int64 -> IO Int64
74+ping sock n = do
75+ NBS.send sock $ encode n
76+ bs <- NBS.recv sock 8
77+ return $ decode bs
78+
79+pong :: Socket -> IO ()
80+pong sock = do
81+ bs <- NBS.recv sock 8
82+ NBS.sendAll sock bs
83+ return ()
84+
85+benchPing :: Socket -> Int64 -> Benchmark
86+benchPing sock n = bench "TCP Ping" $
87+ nfIO (mapM_ (ping sock) [1 .. n])
88+
benchmarks/PingTransport.hsnew file+92
@@ -0,0 +1,92 @@
1+module Main where
2+
3+import Network.Transport
4+import Network.Transport.TCP (mkTransport, TCPConfig (..))
5+
6+import Control.Monad (forever)
7+import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
8+import Data.Binary
9+import Data.Maybe (fromJust)
10+import Data.Int
11+import System.Environment (getArgs, withArgs)
12+
13+import qualified Data.ByteString.Lazy.Char8 as BS
14+
15+-- | This performs a ping benchmark on the TCP transport. This can be
16+-- compiled using:
17+--
18+-- ghc --make -idistributed-process/src -inetwork-transport/src -O2 benchmarks/PingTransport.hs
19+--
20+-- To use the compiled binary, first set up a server:
21+--
22+-- ./benchmarks/PingTransport server 0.0.0.0 8080 sourceAddr
23+--
24+-- Once this is established, launch a client to perform the benchmark. The
25+-- following command sends 1000 pings per mark.
26+--
27+-- ./benchmarks/PingTransport client 0.0.0.0 8081 sourceAddr 1000
28+--
29+-- The server must be restarted between benchmarks.
30+main :: IO ()
31+main = do
32+ args <- getArgs
33+ case args of
34+ "server" : host : service : sourceAddrFilePath : [] -> do
35+ -- establish transport
36+ transport <- mkTransport $ TCPConfig defaultHints host service
37+
38+ -- create ping end
39+ putStrLn "server: creating ping end"
40+ (sourceAddrPing, targetEndPing) <- newConnection transport
41+ BS.writeFile sourceAddrFilePath $ serialize sourceAddrPing
42+
43+ -- create pong end
44+ putStrLn "server: creating pong end"
45+ [sourceAddrPongBS] <- receive targetEndPing
46+ sourceEndPong <- connect . fromJust $ deserialize transport sourceAddrPongBS
47+
48+ -- always respond to a ping with a pong
49+ putStrLn "server: awaiting pings"
50+ forever $ pong targetEndPing sourceEndPong
51+
52+
53+ "client" : host : service : sourceAddrFilePath : pingsStr : args' -> do
54+ let pings = read pingsStr
55+ -- establish transport
56+ transport <- mkTransport $ TCPConfig defaultHints host service
57+
58+ -- create ping end
59+ sourceAddrPingBS <- BS.readFile sourceAddrFilePath
60+ sourceEndPing <- connect . fromJust $ deserialize transport sourceAddrPingBS
61+
62+ -- create pong end
63+ (sourceAddrPong, targetEndPong) <- newConnection transport
64+ send sourceEndPing [serialize sourceAddrPong]
65+
66+ -- benchmark the pings
67+ withArgs args' $ defaultMain [ benchPing sourceEndPing targetEndPong pings]
68+
69+-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
70+-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
71+-- in reply down the `SourceEnd`, repeating whatever was sent.
72+pong :: TargetEnd -> SourceEnd -> IO ()
73+pong targetEndPing sourceEndPong = do
74+ bs <- receive targetEndPing
75+ send sourceEndPong bs
76+
77+-- | The effect of `ping sourceEndPing targetEndPong n` is to send the number
78+-- `n` using `sourceEndPing`, and to then receive the a number from
79+-- `targetEndPong`, which is then returned.
80+ping :: SourceEnd -> TargetEnd -> Int64 -> IO Int64
81+ping sourceEndPing targetEndPong n = do
82+ send sourceEndPing [encode n]
83+ [bs] <- receive targetEndPong
84+ return $ decode bs
85+
86+-- | The effect of `benchPing sourceEndPing targetEndPong n` is to send
87+-- `n` pings down `sourceEndPing` using the `ping` function. The time
88+-- taken is benchmarked.
89+benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
90+benchPing sourceEndPing targetEndPong n = bench "Transport Ping" $
91+ nfIO (mapM_ (ping sourceEndPing targetEndPong) [1 .. n])
92+