@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP, BangPatterns #-}
22
33module Main where
44
@@ -6,14 +6,14 @@ import Network.Transport (newConnection, receive, connect, send, defaultHints,
66 serialize, deserialize, SourceEnd, TargetEnd)
77import Network.Transport.TCP (mkTransport, TCPConfig (..))
88
9−import Control.Monad (forever, replicateM_)
10−import Criterion.Main (Benchmark, bench, defaultMainWith, nfIO)
11−import Criterion.Config (defaultConfig, ljust, Config(cfgSamples))
9+import Control.Monad (forever, replicateM_, forM_)
1210
1311import qualified Data.Serialize as Ser
1412import Data.Maybe (fromJust)
1513import Data.Int
1614import System.Environment (getArgs, withArgs)
15+import Data.Time (getCurrentTime, diffUTCTime)
16+import System.IO (withFile, IOMode(..), hPutStrLn)
1717
1818#ifndef LAZY
1919import qualified Data.ByteString.Char8 as BS
@@ -68,10 +68,10 @@ main = do
6868
6969 -- always respond to a ping with a pong
7070 putStrLn "server: awaiting pings"
71− forever $ pong targetEndPing sourceEndPong
71+ pong targetEndPing sourceEndPong
7272
7373
74− "client" : host : service : sourceAddrFilePath : pingsStr : reps : args' -> do
74+ "client" : host : service : sourceAddrFilePath : pingsStr : [] -> do
7575 let pings = read pingsStr
7676 -- establish transport
7777 transport <- mkTransport $ TCPConfig defaultHints host service
@@ -84,39 +84,39 @@ main = do
8484 (sourceAddrPong, targetEndPong) <- newConnection transport
8585 send sourceEndPing [serialize sourceAddrPong]
8686
87− -- benchmark the pings
88− case (read reps) :: Int of
89− 0 -> error "What would zero reps mean?"
90− 1 -> do putStrLn "Because you're timing only one trial, skipping Criterion..."
91− replicateM_ pings (ping sourceEndPing targetEndPong 42)
92− n -> withArgs args' $ defaultMainWith
93− (defaultConfig{ cfgSamples = ljust n })
94− (return ()) -- Init action.
95− [ benchPing sourceEndPing targetEndPong (fromIntegral pings)]
87+ ping sourceEndPing targetEndPong pings
9688 putStrLn "Done with all ping/pongs."
9789
98−-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
99−-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
100−-- in reply down the `SourceEnd`, repeating whatever was sent.
90+-- | The message we use to ping (CAF so that we don't keep encoding it)
91+pingMessage :: BS.ByteString
92+pingMessage = BS.pack "ping123"
93+
94+-- | Keep replying to pings (send pongs)
10195pong :: TargetEnd -> SourceEnd -> IO ()
10296pong targetEndPing sourceEndPong = do
10397 bs <- receive targetEndPing
10498 send sourceEndPong bs
105−
106−-- | The effect of `ping sourceEndPing targetEndPong n` is to send the number
107−-- `n` using `sourceEndPing`, and to then receive the a number from
108−-- `targetEndPong`, which is then returned.
109−ping :: SourceEnd -> TargetEnd -> Int64 -> IO Int64
110−ping sourceEndPing targetEndPong n = do
111− send sourceEndPing [encode n]
112− [bs] <- receive targetEndPong
113− let (Right n) = decode bs
114− return $! n
115−
116−-- | The effect of `benchPing sourceEndPing targetEndPong n` is to send
117−-- `n` pings down `sourceEndPing` using the `ping` function. The time
118−-- taken is benchmarked.
119−benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
120−benchPing sourceEndPing targetEndPong n = bench "PingTransport" $
121− nfIO (replicateM_ (fromIntegral n) (ping sourceEndPing targetEndPong 42))
122−
99+ pong targetEndPing sourceEndPong
100+
101+-- | Send a number of pings
102+ping :: SourceEnd -> TargetEnd -> Int -> IO ()
103+ping sourceEndPing targetEndPong pings = go [] pings
104+ where
105+ go :: [Double] -> Int -> IO ()
106+ go rtl 0 = do
107+ outputData rtl
108+ putStrLn $ "client did " ++ show pings ++ " pings"
109+ go rtl !i = do
110+ before <- getCurrentTime
111+ send sourceEndPing [pingMessage]
112+ [bs] <- receive targetEndPong
113+ after <- getCurrentTime
114+ let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
115+ latency `seq` go (latency : rtl) (i - 1)
116+
117+-- | Output latencies to a file to be plotted
118+outputData :: [Double] -> IO ()
119+outputData rtl = do
120+ withFile "round-trip-latency-tcp-transport.data" WriteMode $ \h ->
121+ forM_ (zip [0..] rtl) $ \(i, latency) ->
122+ hPutStrLn h $ (show i) ++ " " ++ (show latency)