git.iko.soy/distributed-process
on master help sign in
Add ping benchmark.
commitd58295751275a855860585c7bd0237382332602f authorNicolas Wu <nick@well-typed.com> dateMon 30 Jan 2012, 13:45 (15 years ago) parent473d5d7
3 files changed+199
compare with master
unifiedsplit
README.md+19 benchmarks/PingTCP.hs+88 benchmarks/PingTransport.hs+92
README.md+19
@@ -83,5 +83,24 @@ with their `SourceAddr`. The master then decodes this, and sends a message
8383back. After processing this message, the slaves respond to the master,
8484which then outputs some data.
8585
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+
86105[1]: http://research.microsoft.com/en-us/um/people/simonpj/papers/parallel/remote.pdf
87106[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+