diff options
author | James Crayne <jim.crayne@gmail.com> | 2019-09-28 13:43:29 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-01 19:27:53 -0500 |
commit | 11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch) | |
tree | 5716463275c2d3e902889db619908ded2a73971c /dht/bittorrent/tests/Data/TorrentSpec.hs | |
parent | add2c76bced51fde5e9917e7449ef52be70faf87 (diff) |
Factor out some new libraries
word64-map:
Data.Word64Map
network-addr:
Network.Address
tox-crypto:
Crypto.Tox
lifted-concurrent:
Control.Concurrent.Lifted.Instrument
Control.Concurrent.Async.Lifted.Instrument
psq-wrap:
Data.Wrapper.PSQInt
Data.Wrapper.PSQ
minmax-psq:
Data.MinMaxPSQ
tasks:
Control.Concurrent.Tasks
kad:
Network.Kademlia
Network.Kademlia.Bootstrap
Network.Kademlia.Routing
Network.Kademlia.CommonAPI
Network.Kademlia.Persistence
Network.Kademlia.Search
Diffstat (limited to 'dht/bittorrent/tests/Data/TorrentSpec.hs')
-rw-r--r-- | dht/bittorrent/tests/Data/TorrentSpec.hs | 139 |
1 files changed, 139 insertions, 0 deletions
diff --git a/dht/bittorrent/tests/Data/TorrentSpec.hs b/dht/bittorrent/tests/Data/TorrentSpec.hs new file mode 100644 index 00000000..b4a280e4 --- /dev/null +++ b/dht/bittorrent/tests/Data/TorrentSpec.hs | |||
@@ -0,0 +1,139 @@ | |||
1 | {-# LANGUAGE TypeSynonymInstances #-} | ||
2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
3 | {-# LANGUAGE StandaloneDeriving #-} | ||
4 | {-# OPTIONS -fno-warn-orphans #-} | ||
5 | module Data.TorrentSpec (spec) where | ||
6 | import Control.Applicative | ||
7 | import Data.BEncode | ||
8 | import Data.ByteString as BS | ||
9 | import Data.ByteString.Lazy as BL | ||
10 | import Data.Convertible | ||
11 | import Data.Maybe | ||
12 | import Data.Monoid | ||
13 | import Data.Time | ||
14 | import Network.URI | ||
15 | import System.FilePath | ||
16 | import System.Posix.Types | ||
17 | import Test.Hspec | ||
18 | import Test.QuickCheck | ||
19 | import Test.QuickCheck.Instances () | ||
20 | |||
21 | import Data.Torrent | ||
22 | import Network.BitTorrent.CoreSpec () | ||
23 | |||
24 | |||
25 | pico :: Gen (Maybe NominalDiffTime) | ||
26 | pico = oneof | ||
27 | [ pure Nothing | ||
28 | , (Just . fromIntegral) <$> (arbitrary :: Gen Int) | ||
29 | ] | ||
30 | |||
31 | instance Arbitrary COff where | ||
32 | arbitrary = fromIntegral <$> (arbitrary :: Gen Int) | ||
33 | |||
34 | instance Arbitrary URIAuth where | ||
35 | arbitrary = URIAuth <$> arbitrary <*> arbitrary <*> arbitrary | ||
36 | |||
37 | instance Arbitrary URI where | ||
38 | arbitrary | ||
39 | = pure $ fromJust $ parseURI "http://ietf.org/1737.txt?a=1&b=h#123" | ||
40 | |||
41 | instance Arbitrary InfoHash where | ||
42 | arbitrary = do | ||
43 | bs <- BS.pack <$> vectorOf 20 arbitrary | ||
44 | pure $ either (const (error "arbitrary infohash")) id $ safeConvert bs | ||
45 | |||
46 | instance Arbitrary a => Arbitrary (FileInfo a) where | ||
47 | arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary | ||
48 | |||
49 | instance Arbitrary LayoutInfo where | ||
50 | arbitrary = oneof | ||
51 | [ SingleFile <$> arbitrary | ||
52 | , MultiFile <$> arbitrary <*> arbitrary | ||
53 | ] | ||
54 | |||
55 | instance Arbitrary a => Arbitrary (Piece a) where | ||
56 | arbitrary = Piece <$> arbitrary <*> arbitrary | ||
57 | |||
58 | instance Arbitrary HashList where | ||
59 | arbitrary = HashList <$> arbitrary | ||
60 | |||
61 | instance Arbitrary PieceInfo where | ||
62 | arbitrary = PieceInfo <$> arbitrary <*> arbitrary | ||
63 | |||
64 | instance Arbitrary InfoDict where | ||
65 | arbitrary = infoDictionary <$> arbitrary <*> arbitrary <*> arbitrary | ||
66 | |||
67 | instance Arbitrary Torrent where | ||
68 | arbitrary = Torrent <$> arbitrary | ||
69 | <*> arbitrary <*> arbitrary <*> arbitrary | ||
70 | <*> pico <*> arbitrary <*> arbitrary | ||
71 | <*> arbitrary | ||
72 | <*> arbitrary <*> pure Nothing <*> arbitrary | ||
73 | |||
74 | instance Arbitrary Magnet where | ||
75 | arbitrary = Magnet <$> arbitrary <*> arbitrary | ||
76 | <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary | ||
77 | <*> arbitrary <*> arbitrary <*> pure mempty | ||
78 | |||
79 | type TestPair = (FilePath, String) | ||
80 | |||
81 | -- TODO add a few more torrents here | ||
82 | torrentList :: [TestPair] | ||
83 | torrentList = | ||
84 | [ ( "res" </> "dapper-dvd-amd64.iso.torrent" | ||
85 | , "0221caf96aa3cb94f0f58d458e78b0fc344ad8bf") | ||
86 | ] | ||
87 | |||
88 | infohashSpec :: (FilePath, String) -> Spec | ||
89 | infohashSpec (filepath, expectedHash) = do | ||
90 | it ("should match " ++ filepath) $ do | ||
91 | torrent <- fromFile filepath | ||
92 | let actualHash = show $ idInfoHash $ tInfoDict torrent | ||
93 | actualHash `shouldBe` expectedHash | ||
94 | |||
95 | magnetEncoding :: Magnet -> IO () | ||
96 | magnetEncoding m = parseMagnet (renderMagnet m) `shouldBe` Just m | ||
97 | |||
98 | data T a = T | ||
99 | |||
100 | prop_properBEncode :: Show a => BEncode a => Eq a | ||
101 | => T a -> a -> IO () | ||
102 | prop_properBEncode _ expected = actual `shouldBe` Right expected | ||
103 | where | ||
104 | actual = decode $ BL.toStrict $ encode expected | ||
105 | |||
106 | spec :: Spec | ||
107 | spec = do | ||
108 | describe "info hash" $ do | ||
109 | mapM_ infohashSpec torrentList | ||
110 | |||
111 | describe "accumPosition" $ do | ||
112 | it "" $ property $ \ p1 p2 p3 s1 s2 s3 -> | ||
113 | accumPositions [(p1, s1), (p2, s2), (p3, s3)] | ||
114 | `shouldBe` [(p1, (0, s1)), (p2, (s1, s2)), (p3, (s1 + s2, s3))] | ||
115 | |||
116 | describe "FileInfo" $ do | ||
117 | it "properly bencoded" $ property $ | ||
118 | prop_properBEncode (T :: T (FileInfo BS.ByteString)) | ||
119 | |||
120 | describe "LayoutInfo" $ do | ||
121 | it "properly bencoded" $ property $ | ||
122 | prop_properBEncode (T :: T LayoutInfo) | ||
123 | |||
124 | describe "Torrent" $ do | ||
125 | it "property bencoded" $ property $ | ||
126 | prop_properBEncode (T :: T Torrent) | ||
127 | |||
128 | describe "Magnet" $ do | ||
129 | it "properly encoded" $ property $ magnetEncoding | ||
130 | |||
131 | it "parse base32" $ do | ||
132 | let magnet = "magnet:?xt=urn:btih:CT76LXJDDCH5LS2TUHKH6EUJ3NYKX4Y6" | ||
133 | let ih = "CT76LXJDDCH5LS2TUHKH6EUJ3NYKX4Y6" | ||
134 | parseMagnet magnet `shouldBe` Just (nullMagnet ih) | ||
135 | |||
136 | it "parse base16" $ do | ||
137 | let magnet = "magnet:?xt=urn:btih:0123456789abcdef0123456789abcdef01234567" | ||
138 | let ih = "0123456789abcdef0123456789abcdef01234567" | ||
139 | parseMagnet magnet `shouldBe` Just (nullMagnet ih) | ||