git.iko.soy/distributed-process
on 900dea9 help sign in
distributed-process/benchmarks/PingTCP.hs
109 lines 3.2 kB history raw
1{-# LANGUAGE CPP #-}
3module Main where
5import Control.Monad
6import Criterion.Main (Benchmark, bench, defaultMain, nfIO, bgroup)
8import Data.Int
9import qualified Data.Serialize as Ser
10import Data.Word (Word8)
11import Network.Socket
12 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket
13 , SocketType (Stream), SocketOption (ReuseAddr)
14 , accept, addrAddress, addrFlags, addrFamily, bindSocket, defaultProtocol
15 , defaultHints
16 , getAddrInfo, listen, setSocketOption, socket, sClose, withSocketsDo )
17import System.Environment (getArgs, withArgs)
19import qualified Network.Socket as N
21import Debug.Trace
23#ifndef LAZY
24import Data.ByteString (ByteString)
25import qualified Network.Socket.ByteString as NBS
26encode = Ser.encode
27decode = Ser.decode
28#else
29import Data.ByteString.Lazy (ByteString)
30import qualified Network.Socket.ByteString.Lazy as NBS
31encode = Ser.encodeLazy
32decode = Ser.decodeLazy
33#endif
34{-# INLINE encode #-}
35{-# INLINE decode #-}
36encode :: Ser.Serialize a => a -> ByteString
37decode :: Ser.Serialize a => ByteString -> Either String a
39-- | This performs a ping benchmark on a TCP connection created by
40-- Network.Socket. To compile this file, you might use:
41--
42-- ghc --make -idistributed-process/src -inetwork-transport/src -O2 benchmarks/PingTCP.hs
43--
44-- To use the compiled binary, first set up the server on the current machine:
45--
46-- ./benchmarks/PingTCP server 8080
47--
48-- Next, perform the benchmark on a client using the server address, where
49-- each mark is 1000 pings:
50--
51-- ./benchmarks/PingTCP client 0.0.0.0 8080 1000
52--
53-- The server must be restarted between benchmarks.
54main :: IO ()
55main = do
56 args <- getArgs
57 case args of
58 "server" : service : [] -> withSocketsDo $ do
59 putStrLn "server: creating TCP connection"
60 serverAddrs <- getAddrInfo
61 (Just (defaultHints { addrFlags = [AI_PASSIVE] } ))
62 Nothing
63 (Just service)
64 let serverAddr = head serverAddrs
65 sock <- socket (addrFamily serverAddr) Stream defaultProtocol
66 setSocketOption sock ReuseAddr 1
67 bindSocket sock (addrAddress serverAddr)
69 putStrLn "server: awaiting client connection"
70 listen sock 1
71 (clientSock, clientAddr) <- accept sock
73 putStrLn "server: listening for pings"
74 forever (pong clientSock)
76 "client": host : service : pingsStr : args' -> withSocketsDo $ do
77 let pings = read pingsStr
78 serverAddrs <- getAddrInfo
79 Nothing
80 (Just host)
81 (Just service)
82 let serverAddr = head serverAddrs
83 sock <- socket (addrFamily serverAddr) Stream defaultProtocol
85 N.connect sock (addrAddress serverAddr)
87 -- benchmark the pings
88 withArgs args' $ defaultMain [ benchPing sock pings ]
89-- replicateM_ pings (ping sock)
91-- | Each `ping` sends a single byte, and expects to receive one
92-- back in return.
93ping :: Socket -> IO Int64
94ping sock = do
95 NBS.send sock $ encode (0 :: Int64)
96 bs <- NBS.recv sock 8
97 either error return $ decode bs
99pong :: Socket -> IO ()
100pong sock = do
101 bs <- NBS.recv sock 8
102 NBS.sendAll sock bs
103 return ()
105benchPing :: Socket -> Int64 -> Benchmark
106benchPing sock n =
107 bench "PingTCP" $
108 nfIO (replicateM_ (fromIntegral n) (ping sock))