diff options
Diffstat (limited to 'tests/Main.hs')
-rw-r--r-- | tests/Main.hs | 142 |
1 files changed, 5 insertions, 137 deletions
diff --git a/tests/Main.hs b/tests/Main.hs index 1a758cb2..a968c487 100644 --- a/tests/Main.hs +++ b/tests/Main.hs | |||
@@ -18,7 +18,6 @@ import Data.ByteString (ByteString) | |||
18 | import qualified Data.ByteString as B | 18 | import qualified Data.ByteString as B |
19 | import qualified Data.ByteString.Lazy as Lazy | 19 | import qualified Data.ByteString.Lazy as Lazy |
20 | import Data.List as L | 20 | import Data.List as L |
21 | import Data.Ord | ||
22 | import Data.Maybe | 21 | import Data.Maybe |
23 | import Data.Word | 22 | import Data.Word |
24 | import Data.Serialize as S | 23 | import Data.Serialize as S |
@@ -27,27 +26,20 @@ import Data.Text as T | |||
27 | import Network | 26 | import Network |
28 | import Network.URI | 27 | import Network.URI |
29 | 28 | ||
30 | import System.Directory | ||
31 | import System.FilePath | ||
32 | |||
33 | import Test.QuickCheck as QC | 29 | import Test.QuickCheck as QC |
34 | import Test.HUnit as HU | ||
35 | import Test.Framework as Framework (Test, defaultMain) | 30 | import Test.Framework as Framework (Test, defaultMain) |
36 | import Test.Framework.Providers.QuickCheck2 (testProperty) | 31 | import Test.Framework.Providers.QuickCheck2 (testProperty) |
37 | import Test.Framework.Providers.HUnit (testCase) | ||
38 | 32 | ||
39 | import Data.Aeson as JSON | 33 | import Data.Aeson as JSON |
40 | import Data.BEncode as BE | 34 | import Data.BEncode as BE |
41 | import Data.Bitfield as BF | 35 | import Data.Torrent.Block |
42 | import Data.Torrent | 36 | import Data.Torrent.Bitfield as BF |
43 | import Network.BitTorrent as BT | 37 | import Data.Torrent.Metainfo |
44 | import Network.BitTorrent.Exchange.Protocol | 38 | import Network.BitTorrent.Exchange.Protocol |
45 | import Network.BitTorrent.Tracker | 39 | import Network.BitTorrent.Tracker |
46 | import Network.BitTorrent.Tracker.Protocol | 40 | import Network.BitTorrent.Tracker.Protocol |
47 | import Network.BitTorrent.Tracker.HTTP | 41 | import Network.BitTorrent.Tracker.HTTP |
48 | import Network.BitTorrent.Peer | 42 | import Network.BitTorrent.Peer |
49 | import System.IO.MMap.Fixed hiding (empty, interval) | ||
50 | import qualified System.IO.MMap.Fixed as Fixed | ||
51 | 43 | ||
52 | -- import Debug.Trace | 44 | -- import Debug.Trace |
53 | 45 | ||
@@ -73,71 +65,6 @@ instance Arbitrary Text where | |||
73 | arbitrary = T.pack <$> arbitrary | 65 | arbitrary = T.pack <$> arbitrary |
74 | 66 | ||
75 | {----------------------------------------------------------------------- | 67 | {----------------------------------------------------------------------- |
76 | Bitfield | ||
77 | -----------------------------------------------------------------------} | ||
78 | -- other properties are tested in IntervalSet | ||
79 | |||
80 | prop_completenessRange :: Bitfield -> Bool | ||
81 | prop_completenessRange bf = 0 <= c && c <= 1 | ||
82 | where | ||
83 | c = completeness bf | ||
84 | |||
85 | prop_minMax :: Bitfield -> Bool | ||
86 | prop_minMax bf | ||
87 | | BF.null bf = True | ||
88 | | otherwise = BF.findMin bf <= BF.findMax bf | ||
89 | |||
90 | prop_rarestInRange :: [Bitfield] -> Bool | ||
91 | prop_rarestInRange xs = case rarest xs of | ||
92 | Just r -> 0 <= r | ||
93 | && r < totalCount (maximumBy (comparing totalCount) xs) | ||
94 | Nothing -> True | ||
95 | |||
96 | {- this one should give pretty good coverage -} | ||
97 | prop_differenceDeMorgan :: Bitfield -> Bitfield -> Bitfield -> Bool | ||
98 | prop_differenceDeMorgan a b c = | ||
99 | (a `BF.difference` (b `BF.intersection` c)) | ||
100 | == ((a `BF.difference` b) `BF.union` (a `BF.difference` c)) | ||
101 | && | ||
102 | (a `BF.difference` (b `BF.union` c)) | ||
103 | == ((a `BF.difference` b) `BF.intersection` (a `BF.difference` c)) | ||
104 | |||
105 | |||
106 | {----------------------------------------------------------------------- | ||
107 | Torrent | ||
108 | -----------------------------------------------------------------------} | ||
109 | |||
110 | -- TODO tests for torrent: encoding <-> decoding | ||
111 | instance Arbitrary FileInfo where | ||
112 | arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary | ||
113 | |||
114 | instance Arbitrary ContentInfo where | ||
115 | arbitrary = oneof | ||
116 | [ SingleFile <$> arbitrary <*> arbitrary <*> arbitrary | ||
117 | <*> arbitrary <*> arbitrary <*> arbitrary | ||
118 | , MultiFile <$> arbitrary <*> arbitrary <*> arbitrary | ||
119 | <*> arbitrary <*> arbitrary | ||
120 | ] | ||
121 | |||
122 | instance Arbitrary Torrent where | ||
123 | arbitrary = mktorrent <$> arbitrary | ||
124 | <*> arbitrary <*> arbitrary <*> arbitrary | ||
125 | <*> arbitrary <*> arbitrary <*> arbitrary | ||
126 | <*> arbitrary <*> pure Nothing <*> arbitrary | ||
127 | |||
128 | -- TODO add a few more torrents here | ||
129 | torrentList :: [(FilePath, String)] | ||
130 | torrentList = | ||
131 | [ ( "res" </> "dapper-dvd-amd64.iso.torrent" | ||
132 | , "0221caf96aa3cb94f0f58d458e78b0fc344ad8bf") | ||
133 | ] | ||
134 | |||
135 | checkInfoHash :: (FilePath, String) -> Assertion | ||
136 | checkInfoHash (path, expectedHash) = check =<< fromFile path | ||
137 | where | ||
138 | check t = expectedHash @=? show (ppInfoHash (tInfoHash t)) | ||
139 | |||
140 | {----------------------------------------------------------------------- | ||
141 | Handshake | 68 | Handshake |
142 | -----------------------------------------------------------------------} | 69 | -----------------------------------------------------------------------} |
143 | 70 | ||
@@ -211,10 +138,6 @@ instance Arbitrary BlockIx where | |||
211 | instance Arbitrary Block where | 138 | instance Arbitrary Block where |
212 | arbitrary = Block <$> positive <*> positive <*> arbitrary | 139 | arbitrary = Block <$> positive <*> positive <*> arbitrary |
213 | 140 | ||
214 | instance Arbitrary Bitfield where | ||
215 | arbitrary = mkBitfield <$> (succ . min 1000 <$> positive) | ||
216 | <*> arbitrary | ||
217 | |||
218 | instance Arbitrary PortNumber where | 141 | instance Arbitrary PortNumber where |
219 | arbitrary = fromIntegral <$> (arbitrary :: Gen Word16) | 142 | arbitrary = fromIntegral <$> (arbitrary :: Gen Word16) |
220 | 143 | ||
@@ -226,7 +149,7 @@ instance Arbitrary Message where | |||
226 | , pure Interested | 149 | , pure Interested |
227 | , pure NotInterested | 150 | , pure NotInterested |
228 | , Have <$> positive | 151 | , Have <$> positive |
229 | , Bitfield <$> arbitrary | 152 | , pure $ Bitfield $ BF.haveNone 0 |
230 | , Request <$> arbitrary | 153 | , Request <$> arbitrary |
231 | , Piece <$> arbitrary | 154 | , Piece <$> arbitrary |
232 | , Cancel <$> arbitrary | 155 | , Cancel <$> arbitrary |
@@ -243,68 +166,15 @@ prop_messageEncoding msg | |||
243 | = S.decode (S.encode msg) == Right msg | 166 | = S.decode (S.encode msg) == Right msg |
244 | 167 | ||
245 | {----------------------------------------------------------------------- | 168 | {----------------------------------------------------------------------- |
246 | MemMap | ||
247 | -----------------------------------------------------------------------} | ||
248 | |||
249 | tmpdir :: FilePath | ||
250 | tmpdir = "tmp" | ||
251 | |||
252 | boundaryTest :: Assertion | ||
253 | boundaryTest = do | ||
254 | f <- mallocTo (Fixed.interval 0 1) Fixed.empty | ||
255 | f <- mallocTo (Fixed.interval 1 2) f | ||
256 | writeElem f 0 (1 :: Word8) | ||
257 | writeElem f 1 (2 :: Word8) | ||
258 | bs <- readBytes (Fixed.interval 0 2) f | ||
259 | "\x1\x2" @=? bs | ||
260 | |||
261 | mmapSingle :: Assertion | ||
262 | mmapSingle = do | ||
263 | f <- mmapTo (tmpdir </> "single.test") (10, 5) 5 Fixed.empty | ||
264 | writeBytes (Fixed.interval 5 5) "abcde" f | ||
265 | bs <- readBytes (Fixed.interval 5 5) f | ||
266 | "abcde" @=? bs | ||
267 | |||
268 | coalesceTest :: Assertion | ||
269 | coalesceTest = do | ||
270 | f <- mmapTo (tmpdir </> "a.test") (0, 1) 10 Fixed.empty | ||
271 | f <- mmapTo (tmpdir </> "bc.test") (0, 2) 12 f | ||
272 | f <- mmapTo (tmpdir </> "c.test") (0, 1) 13 f | ||
273 | writeBytes (Fixed.interval 10 4) "abcd" f | ||
274 | bs <- readBytes (Fixed.interval 10 4) f | ||
275 | "abcd" @=? bs | ||
276 | |||
277 | {----------------------------------------------------------------------- | ||
278 | Main | 169 | Main |
279 | -----------------------------------------------------------------------} | 170 | -----------------------------------------------------------------------} |
280 | 171 | ||
281 | allTests :: [Framework.Test] | 172 | allTests :: [Framework.Test] |
282 | allTests = | 173 | allTests = |
283 | [ -- bitfield module | ||
284 | testProperty "completeness range" prop_completenessRange | ||
285 | , testProperty "rarest in range" prop_rarestInRange | ||
286 | , testProperty "min less that max" prop_minMax | ||
287 | , testProperty "difference de morgan" prop_differenceDeMorgan | ||
288 | |||
289 | -- torrent module | ||
290 | , testProperty "file info encoding" $ | ||
291 | prop_properBEncode (T :: T FileInfo) | ||
292 | , testProperty "content info encoding" $ | ||
293 | prop_properBEncode (T :: T ContentInfo) | ||
294 | , testProperty "torrent encoding" $ | ||
295 | prop_properBEncode (T :: T Torrent) | ||
296 | ] ++ | ||
297 | fmap (testCase "info hash" . checkInfoHash) torrentList | ||
298 | ++ | ||
299 | [ -- handshake module | 174 | [ -- handshake module |
300 | testProperty "handshake encoding" $ | 175 | testProperty "handshake encoding" $ |
301 | prop_cerealEncoding (T :: T Handshake) | 176 | prop_cerealEncoding (T :: T Handshake) |
302 | , testProperty "message encoding" prop_messageEncoding | 177 | , testProperty "message encoding" prop_messageEncoding |
303 | |||
304 | -- mem map | ||
305 | , testCase "boudary" boundaryTest | ||
306 | , testCase "single" mmapSingle | ||
307 | , testCase "coalesce" coalesceTest | ||
308 | ] ++ test_scrape_url | 178 | ] ++ test_scrape_url |
309 | ++ | 179 | ++ |
310 | [ testProperty "scrape bencode" $ | 180 | [ testProperty "scrape bencode" $ |
@@ -312,6 +182,4 @@ allTests = | |||
312 | ] | 182 | ] |
313 | 183 | ||
314 | main :: IO () | 184 | main :: IO () |
315 | main = do | 185 | main = defaultMain allTests |
316 | createDirectoryIfMissing True tmpdir | ||
317 | defaultMain allTests | ||