git.iko.soy/distributed-process
on c7f72ce help sign in
distributed-process/benchmarks/PingPipes.hs
112 lines 4.2 kB history raw
1module Main where
3-- TODO: Merge with PingTCPTransport and factor differences.
5import Network.Transport (newConnection, receive, connect, send,
6 serialize, deserialize, SourceEnd, TargetEnd)
7import Network.Transport.Pipes (mkTransport)
9import Control.Monad (forever, replicateM_)
10import Criterion.Main (Benchmark, bench, defaultMainWith, nfIO)
11import Criterion.Config (defaultConfig, ljust, Config(cfgSamples))
12-- import Data.Binary (encode,decode)
13import Data.Serialize (encode,decode)
14import Data.Maybe (fromJust)
15import Data.Int
16import System.Environment (getArgs, withArgs)
18-- import qualified Data.ByteString.Lazy.Char8 as LBS
19import qualified Data.ByteString.Char8 as BS
21-- | This performs a ping benchmark on the TCP transport. This can be
22-- compiled using:
23--
24-- ghc --make -idistributed-process/src -inetwork-transport/src -O2 benchmarks/PingTransport.hs
25--
26-- To use the compiled binary, first set up a server:
27--
28-- ./benchmarks/PingPipes server sourceAddr
29--
30-- Once this is established, launch a client to perform the benchmark. The
31-- following command sends 1000 pings per mark.
32--
33-- ./benchmarks/PingPipes client sourceAddr 1000
34--
35-- The server must be restarted between benchmarks.
36main :: IO ()
37main = do
38 args <- getArgs
39 case args of
40 "server" : sourceAddrFilePath : [] -> do
41 -- establish transport
42 transport <- mkTransport
44 -- create ping end
45 putStrLn "server: creating ping end"
46 (sourceAddrPing, targetEndPing) <- newConnection transport
47 BS.writeFile sourceAddrFilePath $ serialize sourceAddrPing
49 -- create pong end
50 putStrLn "server: creating pong end"
51 [sourceAddrPongBS] <- receive targetEndPing
52 sourceEndPong <- connect . fromJust $ deserialize transport sourceAddrPongBS
54 -- always respond to a ping with a pong
55 putStrLn "server: awaiting pings"
56 forever $ pong targetEndPing sourceEndPong
59 "client" : sourceAddrFilePath : pingsStr : reps : args' -> do
60 let pings = read pingsStr
61 -- establish transport
62 transport <- mkTransport
64 -- create ping end
65 sourceAddrPingBS <- BS.readFile sourceAddrFilePath
66 sourceEndPing <- connect . fromJust $ deserialize transport sourceAddrPingBS
68 -- create pong end
69 (sourceAddrPong, targetEndPong) <- newConnection transport
70 send sourceEndPing [serialize sourceAddrPong]
72 -- benchmark the pings
73 case (read reps) :: Int of
74 0 -> error "What would zero reps mean?"
75 1 -> do putStrLn "Because you're timing only one trial, skipping Criterion..."
76 replicateM_ pings (ping sourceEndPing targetEndPong)
77 n -> withArgs args' $ defaultMainWith
78 (defaultConfig{ cfgSamples = ljust n })
79 (return ()) -- Init action.
80 [ benchPing sourceEndPing targetEndPong (fromIntegral pings) ]
81 putStrLn "Done with all ping/pongs."
84-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
85-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
86-- in reply down the `SourceEnd`, repeating whatever was sent.
87pong :: TargetEnd -> SourceEnd -> IO ()
88pong targetEndPing sourceEndPong = do
89 bs <- receive targetEndPing
90 send sourceEndPong bs
92-- | The effect of `ping sourceEndPing targetEndPong n` is to send the number
93-- `n` using `sourceEndPing`, and to then receive the a number from
94-- `targetEndPong`, which is then returned.
95ping :: SourceEnd -> TargetEnd -> IO Int64
96ping sourceEndPing targetEndPong = do
97 -- send sourceEndPing [BS.empty]
98 send sourceEndPing [encode (42 :: Int64)]
100 [bs] <- receive targetEndPong
101-- return $ decode bs
102 case decode bs of
103 Left err -> error$ "decode failure: " ++ err
104 Right x -> return x
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))