summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Network/BitTorrent')
-rw-r--r--tests/Network/BitTorrent/Tracker/MessageSpec.hs27
1 files changed, 25 insertions, 2 deletions
diff --git a/tests/Network/BitTorrent/Tracker/MessageSpec.hs b/tests/Network/BitTorrent/Tracker/MessageSpec.hs
index 99518067..8a06aaba 100644
--- a/tests/Network/BitTorrent/Tracker/MessageSpec.hs
+++ b/tests/Network/BitTorrent/Tracker/MessageSpec.hs
@@ -3,14 +3,19 @@ module Network.BitTorrent.Tracker.MessageSpec (spec) where
3 3
4import Control.Applicative 4import Control.Applicative
5import Data.BEncode as BE 5import Data.BEncode as BE
6import Data.ByteString.Char8 as BC
6import Data.ByteString.Lazy as BL 7import Data.ByteString.Lazy as BL
8import Data.List as L
7import Data.Maybe 9import Data.Maybe
8import Data.Word 10import Data.Word
11import Data.Text
9import Network 12import Network
10import Network.URI 13import Network.URI
11import Test.Hspec 14import Test.Hspec
12import Test.QuickCheck 15import Test.QuickCheck
13--import Network.HTTP.Types.URI 16import Test.QuickCheck.Gen
17import Network.HTTP.Types.URI
18import System.Random
14 19
15import Data.Torrent.InfoHashSpec () 20import Data.Torrent.InfoHashSpec ()
16import Data.Torrent.ProgressSpec () 21import Data.Torrent.ProgressSpec ()
@@ -39,9 +44,27 @@ instance Arbitrary AnnounceQuery where
39baseURI :: URI 44baseURI :: URI
40baseURI = fromJust $ parseURI "http://a" 45baseURI = fromJust $ parseURI "http://a"
41 46
47parseUriQuery :: URI -> [(Text, Text)]
48parseUriQuery = filterMaybes . parseQueryText . BC.pack . uriQuery
49 where
50 filterMaybes :: [(a, Maybe b)] -> [(a, b)]
51 filterMaybes = catMaybes . L.map f
52 where
53 f (a, Nothing) = Nothing
54 f (a, Just b ) = Just (a, b)
55
56test = do
57 let q = unGen arbitrary (mkStdGen 0) 0
58 print $ renderAnnounceQuery baseURI q
59 print $ parseUriQuery $ renderAnnounceQuery baseURI q
60
42spec :: Spec 61spec :: Spec
43spec = do 62spec = do
44 describe "Announce" $ do 63 describe "Announce" $ do
45 return () 64 before test $
65 it "properly url encoded" $ property $ \ q ->
66 parseAnnounceQuery (parseUriQuery (renderAnnounceQuery baseURI q))
67 `shouldBe` Right q
68
46 describe "Scrape" $ do 69 describe "Scrape" $ do
47 return () 70 return ()