git.iko.soy/distributed-process
on c7f72ce help sign in
distributed-process/benchmarks/SendTransport.hs
117 lines 4.3 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE NoMonomorphismRestriction #-}
4module Main where
6import Network.Transport (newConnection, receive, connect, send, defaultHints,
7 serialize, deserialize, SourceEnd, TargetEnd)
8import Network.Transport.TCP (mkTransport, TCPConfig (..))
10import Control.Applicative
11import Control.Monad (forever, replicateM, replicateM_)
12import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
13import qualified Data.Serialize as Ser
14import Data.Maybe (fromJust)
15import Data.Int
16import System.Environment (getArgs, withArgs)
17import System.Random
19#ifndef LAZY
20import Data.ByteString (ByteString)
21import qualified Data.ByteString.Char8 as BS
22import qualified Network.Socket.ByteString as NBS
23encode = Ser.encode
24decode = Ser.decode
25#else
26import Data.ByteString.Lazy (ByteString)
27import qualified Data.ByteString.Lazy.Char8 as BS
28import qualified Network.Socket.ByteString.Lazy as NBS
29encode = Ser.encodeLazy
30decode = Ser.decodeLazy
31#endif
32{-# INLINE encode #-}
33{-# INLINE decode #-}
34encode :: Ser.Serialize a => a -> ByteString
35decode :: Ser.Serialize a => ByteString -> Either String a
37-- | This performs a benchmark on the TCP transport to measure how long
38-- it takes to transfer a number of bytes. This can be compiled using:
39--
40-- ghc --make -idistributed-process/src -inetwork-transport/src -O2 benchmarks/SendTransport.hs
41--
42-- To use the compiled binary, first set up a server:
43--
44-- ./benchmarks/SendTransport server 0.0.0.0 8080 sourceAddr
45--
46-- Once this is established, launch a client to perform the benchmark. The
47-- following command sends 1000 bytes per mark.
48--
49-- ./benchmarks/SendTransport client 0.0.0.0 8081 sourceAddr 1000
50--
51-- The server must be restarted between benchmarks.
52main :: IO ()
53main = do
54 args <- getArgs
55 case args of
56 "server" : host : service : sourceAddrFilePath : [] -> do
58 -- establish transport
59 transport <- mkTransport $ TCPConfig defaultHints host service
61 -- create ping end
62 putStrLn "server: creating ping end"
63 (sourceAddrPing, targetEndPing) <- newConnection transport
64 BS.writeFile sourceAddrFilePath $ serialize sourceAddrPing
66 -- create pong end
67 putStrLn "server: creating pong end"
68 [sourceAddrPongBS] <- receive targetEndPing
69 sourceEndPong <- connect . fromJust $ deserialize transport sourceAddrPongBS
71 -- always respond to a ping with a pong
72 putStrLn "server: awaiting pings"
73 forever $ pong targetEndPing sourceEndPong
76 "client" : host : service : sourceAddrFilePath : sizeStr : args' -> do
77 let size = read sizeStr
79 -- establish transport
80 transport <- mkTransport $ TCPConfig defaultHints host service
82 -- create ping end
83 sourceAddrPingBS <- BS.readFile sourceAddrFilePath
84 sourceEndPing <- connect . fromJust $ deserialize transport sourceAddrPingBS
86 -- create pong end
87 (sourceAddrPong, targetEndPong) <- newConnection transport
88 send sourceEndPing [serialize sourceAddrPong]
90 -- benchmark the data
91 bs <- BS.pack <$> replicateM size randomIO
92 withArgs args' $ defaultMain [ benchSend sourceEndPing targetEndPong bs ]
94-- | The effect of `ping sourceEndPing targetEndPong bs` is to send the
95-- `ByteString` `bs` using `sourceEndPing`, and to then receive
96-- that string back. Returns the length of the received message.
97ping :: SourceEnd -> TargetEnd -> ByteString -> IO Int
98ping sourceEndPing targetEndPong bs = do
99 send sourceEndPing [bs]
100 cs <- receive targetEndPong
101 return . fromIntegral $! sum (map BS.length cs)
103-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
104-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
105-- in reply down the `SourceEnd`, repeating whatever was sent.
106pong :: TargetEnd -> SourceEnd -> IO ()
107pong targetEndPing sourceEndPong = do
108 bs <- receive targetEndPing
109 send sourceEndPong bs
111-- | The effect of `benchSend sourceEndPing targetEndPong bs` is to send
112-- `bs` pings down `sourceEndPing` using the `ping` function. The time
113-- taken is benchmarked.
114benchSend :: SourceEnd -> TargetEnd -> ByteString -> Benchmark
115benchSend sourceEndPing targetEndPong bs = bench "SendTransport" $
116 nfIO (ping sourceEndPing targetEndPong bs)