diff options
Diffstat (limited to 'tests/Network')
-rw-r--r-- | tests/Network/BitTorrent/Core/PeerIdSpec.hs | 9 | ||||
-rw-r--r-- | tests/Network/BitTorrent/Tracker/MessageSpec.hs | 12 |
2 files changed, 9 insertions, 12 deletions
diff --git a/tests/Network/BitTorrent/Core/PeerIdSpec.hs b/tests/Network/BitTorrent/Core/PeerIdSpec.hs index 7153ef68..4e9f1655 100644 --- a/tests/Network/BitTorrent/Core/PeerIdSpec.hs +++ b/tests/Network/BitTorrent/Core/PeerIdSpec.hs | |||
@@ -1,15 +1,18 @@ | |||
1 | module Network.BitTorrent.Core.PeerIdSpec (spec) where | 1 | module Network.BitTorrent.Core.PeerIdSpec (spec) where |
2 | import Control.Applicative | 2 | import Control.Applicative |
3 | import Data.Text.Encoding as T | ||
3 | import Test.Hspec | 4 | import Test.Hspec |
4 | import Test.QuickCheck | 5 | import Test.QuickCheck |
5 | import Test.QuickCheck.Instances | 6 | import Test.QuickCheck.Instances () |
6 | import Network.BitTorrent.Core.PeerId | 7 | import Network.BitTorrent.Core.PeerId |
7 | 8 | ||
8 | 9 | ||
9 | instance Arbitrary PeerId where | 10 | instance Arbitrary PeerId where |
10 | arbitrary = oneof | 11 | arbitrary = oneof |
11 | [ azureusStyle defaultClientId defaultVersionNumber <$> arbitrary | 12 | [ azureusStyle defaultClientId defaultVersionNumber |
12 | , shadowStyle 'X' defaultVersionNumber <$> arbitrary | 13 | <$> pure "" |
14 | -- , shadowStyle 'X' defaultVersionNumber | ||
15 | -- <$> (T.encodeUtf8 <$> arbitrary) | ||
13 | ] | 16 | ] |
14 | 17 | ||
15 | spec :: Spec | 18 | spec :: Spec |
diff --git a/tests/Network/BitTorrent/Tracker/MessageSpec.hs b/tests/Network/BitTorrent/Tracker/MessageSpec.hs index 8a06aaba..2a882c5d 100644 --- a/tests/Network/BitTorrent/Tracker/MessageSpec.hs +++ b/tests/Network/BitTorrent/Tracker/MessageSpec.hs | |||
@@ -44,8 +44,8 @@ instance Arbitrary AnnounceQuery where | |||
44 | baseURI :: URI | 44 | baseURI :: URI |
45 | baseURI = fromJust $ parseURI "http://a" | 45 | baseURI = fromJust $ parseURI "http://a" |
46 | 46 | ||
47 | parseUriQuery :: URI -> [(Text, Text)] | 47 | parseUriQuery :: URI -> SimpleQuery |
48 | parseUriQuery = filterMaybes . parseQueryText . BC.pack . uriQuery | 48 | parseUriQuery = filterMaybes . parseQuery . BC.pack . uriQuery |
49 | where | 49 | where |
50 | filterMaybes :: [(a, Maybe b)] -> [(a, b)] | 50 | filterMaybes :: [(a, Maybe b)] -> [(a, b)] |
51 | filterMaybes = catMaybes . L.map f | 51 | filterMaybes = catMaybes . L.map f |
@@ -53,16 +53,10 @@ parseUriQuery = filterMaybes . parseQueryText . BC.pack . uriQuery | |||
53 | f (a, Nothing) = Nothing | 53 | f (a, Nothing) = Nothing |
54 | f (a, Just b ) = Just (a, b) | 54 | f (a, Just b ) = Just (a, b) |
55 | 55 | ||
56 | test = do | ||
57 | let q = unGen arbitrary (mkStdGen 0) 0 | ||
58 | print $ renderAnnounceQuery baseURI q | ||
59 | print $ parseUriQuery $ renderAnnounceQuery baseURI q | ||
60 | |||
61 | spec :: Spec | 56 | spec :: Spec |
62 | spec = do | 57 | spec = do |
63 | describe "Announce" $ do | 58 | describe "Announce" $ do |
64 | before test $ | 59 | it "properly url encoded" $ property $ \ q -> |
65 | it "properly url encoded" $ property $ \ q -> | ||
66 | parseAnnounceQuery (parseUriQuery (renderAnnounceQuery baseURI q)) | 60 | parseAnnounceQuery (parseUriQuery (renderAnnounceQuery baseURI q)) |
67 | `shouldBe` Right q | 61 | `shouldBe` Right q |
68 | 62 | ||