diff options
author | joe <joe@jerkface.net> | 2017-09-15 06:22:10 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-09-15 06:22:10 -0400 |
commit | 12cbb3af2413dc28838ed271351dda16df8f7bdb (patch) | |
tree | 2db77a787e18a81a8369a8d73fee369d8826f064 /bittorrent/bench/Main.hs | |
parent | 362357c6d08cbd8dffa627a1e80199dcb9ba231f (diff) |
Separating dht-client library from bittorrent package.
Diffstat (limited to 'bittorrent/bench/Main.hs')
-rw-r--r-- | bittorrent/bench/Main.hs | 75 |
1 files changed, 75 insertions, 0 deletions
diff --git a/bittorrent/bench/Main.hs b/bittorrent/bench/Main.hs new file mode 100644 index 00000000..f04485ab --- /dev/null +++ b/bittorrent/bench/Main.hs | |||
@@ -0,0 +1,75 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
3 | {-# OPTIONS -fno-warn-orphans #-} | ||
4 | module Main (main) where | ||
5 | |||
6 | import Control.DeepSeq | ||
7 | import Network | ||
8 | import Control.Monad | ||
9 | import Control.Monad.Logger | ||
10 | import Control.Monad.Reader | ||
11 | import Criterion.Main | ||
12 | import Data.ByteString as BS | ||
13 | import Network.DatagramServer | ||
14 | |||
15 | |||
16 | import Network.BitTorrent.Exchange.Protocol as BT | ||
17 | import Data.Torrent.Block as BT | ||
18 | import Data.Torrent.Bitfield as BT | ||
19 | |||
20 | instance KRPC ByteString ByteString where | ||
21 | method = "echo" | ||
22 | |||
23 | instance MonadLogger IO where | ||
24 | monadLoggerLog _ _ _ _ = return () | ||
25 | |||
26 | |||
27 | instance NFData PortNumber where | ||
28 | rnf = rnf . (fromIntegral :: PortNumber -> Int) | ||
29 | |||
30 | instance NFData BlockIx where | ||
31 | rnf (BlockIx a b c) = a `deepseq` b `deepseq` rnf c | ||
32 | |||
33 | instance NFData Block where | ||
34 | rnf (Block a b c) = a `deepseq` b `deepseq` rnf c | ||
35 | |||
36 | instance NFData Bitfield | ||
37 | |||
38 | instance NFData Message where | ||
39 | rnf (Have i) = rnf i | ||
40 | rnf (Bitfield b) = rnf b | ||
41 | rnf (Request b) = rnf b | ||
42 | rnf (Piece b) = rnf b | ||
43 | rnf (Cancel b) = rnf b | ||
44 | rnf (Port i) = rnf i | ||
45 | rnf _ = () -- other fields are forced by pattern matching | ||
46 | |||
47 | {- | ||
48 | encodeMessages :: [Message] -> ByteString | ||
49 | encodeMessages xs = runPut (mapM_ put xs) | ||
50 | |||
51 | decodeMessages :: ByteString -> Either String [Message] | ||
52 | decodeMessages = runGet (many get) | ||
53 | -} | ||
54 | |||
55 | echo :: Handler IO | ||
56 | echo = handler $ \ _ bs -> return (bs :: ByteString) | ||
57 | |||
58 | addr :: SockAddr | ||
59 | addr = SockAddrInet 6000 (256 * 256 * 256 + 127) | ||
60 | |||
61 | -- main :: IO () | ||
62 | -- main = defaultMain [] | ||
63 | main :: IO () | ||
64 | main = withManager def addr [echo] $ \ m -> (`runReaderT` m) $ do | ||
65 | listen | ||
66 | liftIO $ defaultMain (benchmarks m) | ||
67 | where | ||
68 | sizes = [10, 100, 1000, 10000, 16 * 1024] | ||
69 | repetitions = [1, 10, 100, 1000] | ||
70 | benchmarks m = [mkbench m r s | r <- repetitions, s <- sizes] | ||
71 | where | ||
72 | mkbench action r n = | ||
73 | bench (show r ++ "times" ++ "/" ++ show n ++ "bytes") $ nfIO $ | ||
74 | replicateM r $ | ||
75 | runReaderT (query addr (BS.replicate n 0)) action | ||