git.iko.soy/distributed-process
on 900dea9 help sign in
distributed-process/benchmarks/PingTransport.hs
112 lines 4.0 kB history raw
1{-# LANGUAGE CPP #-}
3module Main where
5import Network.Transport
6import Network.Transport.TCP (mkTransport, TCPConfig (..))
8import Control.Monad (forever, replicateM_)
9import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
10import qualified Data.Serialize as Ser
11import Data.Maybe (fromJust)
12import Data.Int
13import System.Environment (getArgs, withArgs)
15#ifndef LAZY
16import qualified Data.ByteString.Char8 as BS
17import qualified Network.Socket.ByteString as NBS
18encode = Ser.encode
19decode = Ser.decode
20#else
21import qualified Data.ByteString.Lazy.Char8 as BS
22import qualified Network.Socket.ByteString.Lazy as NBS
23encode = Ser.encodeLazy
24decode = Ser.decodeLazy
25#endif
26{-# INLINE encode #-}
27{-# INLINE decode #-}
28encode :: Ser.Serialize a => a -> BS.ByteString
29decode :: Ser.Serialize a => BS.ByteString -> Either String a
33-- | This performs a ping benchmark on the TCP transport. This can be
34-- compiled using:
35--
36-- ghc --make -idistributed-process/src -inetwork-transport/src -O2 benchmarks/PingTransport.hs
37--
38-- To use the compiled binary, first set up a server:
39--
40-- ./benchmarks/PingTransport server 0.0.0.0 8080 sourceAddr
41--
42-- Once this is established, launch a client to perform the benchmark. The
43-- following command sends 1000 pings per mark.
44--
45-- ./benchmarks/PingTransport client 0.0.0.0 8081 sourceAddr 1000
46--
47-- The server must be restarted between benchmarks.
48main :: IO ()
49main = do
50 args <- getArgs
51 case args of
52 "server" : host : service : sourceAddrFilePath : [] -> do
53 -- establish transport
54 transport <- mkTransport $ TCPConfig defaultHints host service
56 -- create ping end
57 putStrLn "server: creating ping end"
58 (sourceAddrPing, targetEndPing) <- newConnection transport
59 BS.writeFile sourceAddrFilePath $ serialize sourceAddrPing
61 -- create pong end
62 putStrLn "server: creating pong end"
63 [sourceAddrPongBS] <- receive targetEndPing
64 sourceEndPong <- connect . fromJust $ deserialize transport sourceAddrPongBS
66 -- always respond to a ping with a pong
67 putStrLn "server: awaiting pings"
68 forever $ pong targetEndPing sourceEndPong
71 "client" : host : service : sourceAddrFilePath : pingsStr : args' -> do
72 let pings = read pingsStr
73 -- establish transport
74 transport <- mkTransport $ TCPConfig defaultHints host service
76 -- create ping end
77 sourceAddrPingBS <- BS.readFile sourceAddrFilePath
78 sourceEndPing <- connect . fromJust $ deserialize transport sourceAddrPingBS
80 -- create pong end
81 (sourceAddrPong, targetEndPong) <- newConnection transport
82 send sourceEndPing [serialize sourceAddrPong]
84 -- benchmark the pings
85 withArgs args' $ defaultMain [ benchPing sourceEndPing targetEndPong pings]
86-- replicateM_ pings (ping sourceEndPing targetEndPong)
88-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
89-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
90-- in reply down the `SourceEnd`, repeating whatever was sent.
91pong :: TargetEnd -> SourceEnd -> IO ()
92pong targetEndPing sourceEndPong = do
93 bs <- receive targetEndPing
94 send sourceEndPong bs
96-- | The effect of `ping sourceEndPing targetEndPong n` is to send the number
97-- `n` using `sourceEndPing`, and to then receive the a number from
98-- `targetEndPong`, which is then returned.
99ping :: SourceEnd -> TargetEnd -> Int64 -> IO Int64
100ping sourceEndPing targetEndPong n = do
101 send sourceEndPing [encode n]
102 [bs] <- receive targetEndPong
103 let (Right n) = decode bs
104 return $! n
106-- | The effect of `benchPing sourceEndPing targetEndPong n` is to send
107-- `n` pings down `sourceEndPing` using the `ping` function. The time
108-- taken is benchmarked.
109benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
110benchPing sourceEndPing targetEndPong n = bench "PingTransport" $
111 nfIO (replicateM_ (fromIntegral n) (ping sourceEndPing targetEndPong 42))