1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
{-# OPTIONS -fno-warn-orphans #-}
module Main (main) where
import Control.Applicative
import Control.DeepSeq
import Criterion.Main
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Serialize
import Network
import Network.BitTorrent as BT
import Data.Bitfield as BT
instance NFData PortNumber where
rnf = rnf . (fromIntegral :: PortNumber -> Int)
instance NFData BlockIx where
rnf (BlockIx a b c) = a `deepseq` b `deepseq` rnf c
instance NFData Block where
rnf (Block a b c) = a `deepseq` b `deepseq` rnf c
instance NFData Bitfield where
rnf = rnf . bfBits
instance NFData Message where
rnf (Have i) = rnf i
rnf (Bitfield b) = rnf b
rnf (Request b) = rnf b
rnf (Piece b) = rnf b
rnf (Cancel b) = rnf b
rnf (Port i) = rnf i
rnf _ = () -- other fields are forced by pattern matching
encodeMessages :: [Message] -> ByteString
encodeMessages xs = runPut (mapM_ put xs)
decodeMessages :: ByteString -> Either String [Message]
decodeMessages = runGet (many get)
bitfieldMin :: Int -> Maybe Int
bitfieldMin n = findMin (BT.empty n)
bitfieldMax :: Int -> Maybe Int
bitfieldMax n = findMax (BT.empty n)
bitfieldDiff :: Int -> Bitfield
bitfieldDiff n = BT.empty n `difference` BT.empty n
bitfieldInter :: Int -> Bitfield
bitfieldInter n = BT.empty n `intersection` BT.empty n
bitfieldUnion :: Int -> Bitfield
bitfieldUnion n = BT.empty n `union` BT.empty n
bitfieldHaveCount :: Int -> Int
bitfieldHaveCount n = haveCount (BT.full n)
selectionStrictFirst :: Int -> Maybe Int
selectionStrictFirst n = strictFirst (BT.empty n) (BT.empty n) []
selectionStrictLast :: Int -> Maybe Int
selectionStrictLast n = strictLast (BT.empty n) (BT.empty n) []
selectionRarestFirst :: Int -> Maybe Int
selectionRarestFirst n = rarestFirst (BT.empty n) (BT.empty n)
(replicate 10 (BT.empty n))
selectionEndGame :: Int -> Maybe Int
selectionEndGame n = endGame (BT.empty n) (BT.empty n) []
main :: IO ()
main = do
let blockixs = replicate 5000 (Request (BlockIx 0 0 0))
let bitfields = replicate 5000 (Bitfield (MkBitfield (B.replicate 1000 0)))
let chokes = replicate 5000 Choke
let havenones = replicate 5000 HaveNone
let m = 1024 * 1024
defaultMain $
concatMap (uncurry mkMsgBench)
[ ("blockIx", blockixs)
, ("bitfield", bitfields)
, ("choke", chokes)
, ("havenone", havenones)
]
++ -- 256KiB * 10M = 2.5TiB bitfield for 10 ms
[ bench "bitfield/min" $ nf bitfieldMin (10 * m)
, bench "bitfield/max" $ nf bitfieldMax (10 * m)
, bench "bitfield/difference" $ nf bitfieldDiff (10 * m)
, bench "bitfield/intersection" $ nf bitfieldInter (10 * m)
, bench "bitfield/union" $ nf bitfieldUnion (10 * m)
, bench "bitfield/haveCount" $ nf bitfieldHaveCount (10 * m)
, bench "selection/strictFirst" $ nf selectionStrictFirst (10 * m)
, bench "selection/strictLast" $ nf selectionStrictLast (10 * m)
, bench "selection/rarestFirst" $ nf selectionRarestFirst (10 * m)
, bench "selection/endGame" $ nf selectionEndGame (10 * m)
]
where
mkMsgBench name msgs =
[ msgs `deepseq` bench ("message/" ++ name ++ "/encode") $ nf encodeMessages msgs
, let binary = encodeMessages msgs in
binary `deepseq` bench ("message/" ++ name ++ "/decode") $ nf decodeMessages binary
]
|
