git.iko.soy/distributed-process
on 900dea9 help sign in
distributed-process/benchmarks/PingPipes.hs
94 lines 3.3 kB history raw
1module Main where
3import Network.Transport
4import Network.Transport.Pipes (mkTransport)
6import Control.Monad (forever, replicateM_)
7import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
8import Data.Binary
9import Data.Maybe (fromJust)
10import Data.Int
11import System.Environment (getArgs, withArgs)
13import qualified Data.ByteString.Lazy.Char8 as BS
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/PingPipes server 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/PingPipes client sourceAddr 1000
28--
29-- The server must be restarted between benchmarks.
30main :: IO ()
31main = do
32 args <- getArgs
33 case args of
34 "server" : sourceAddrFilePath : [] -> do
35 -- establish transport
36 transport <- mkTransport
38 -- create ping end
39 putStrLn "server: creating ping end"
40 (sourceAddrPing, targetEndPing) <- newConnection transport
41 BS.writeFile sourceAddrFilePath $ serialize sourceAddrPing
43 -- create pong end
44 putStrLn "server: creating pong end"
45 [sourceAddrPongBS] <- receive targetEndPing
46 sourceEndPong <- connect . fromJust $ deserialize transport sourceAddrPongBS
48 -- always respond to a ping with a pong
49 putStrLn "server: awaiting pings"
50 forever $ pong targetEndPing sourceEndPong
53 "client" : sourceAddrFilePath : pingsStr : args' -> do
54 let pings = read pingsStr
55 -- establish transport
56 transport <- mkTransport
58 -- create ping end
59 sourceAddrPingBS <- BS.readFile sourceAddrFilePath
60 sourceEndPing <- connect . fromJust $ deserialize transport sourceAddrPingBS
62 -- create pong end
63 (sourceAddrPong, targetEndPong) <- newConnection transport
64 send sourceEndPing [serialize sourceAddrPong]
66 -- benchmark the pings
67-- withArgs args' $ defaultMain [ benchPing sourceEndPing targetEndPong pings]
68 replicateM_ pings (ping sourceEndPing targetEndPong)
69 putStrLn "Done with all ping/pongs."
71-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
72-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
73-- in reply down the `SourceEnd`, repeating whatever was sent.
74pong :: TargetEnd -> SourceEnd -> IO ()
75pong targetEndPing sourceEndPong = do
76 bs <- receive targetEndPing
77 send sourceEndPong bs
79-- | The effect of `ping sourceEndPing targetEndPong n` is to send the number
80-- `n` using `sourceEndPing`, and to then receive the a number from
81-- `targetEndPong`, which is then returned.
82ping :: SourceEnd -> TargetEnd -> IO Int64
83ping sourceEndPing targetEndPong = do
84 send sourceEndPing [BS.empty]
85 [bs] <- receive targetEndPong
86 return $ decode bs
88-- | The effect of `benchPing sourceEndPing targetEndPong n` is to send
89-- `n` pings down `sourceEndPing` using the `ping` function. The time
90-- taken is benchmarked.
91benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
92benchPing sourceEndPing targetEndPong n = bench "PingTransport" $
93 nfIO (replicateM_ (fromIntegral n) (ping sourceEndPing targetEndPong))