More informative ParamParseFailure

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
 
 import Control.Applicative
 import Data.BEncode as BE
+import Data.ByteString.Char8 as BC
 import Data.ByteString.Lazy as BL
+import Data.List as L
 import Data.Maybe
 import Data.Word
+import Data.Text
 import Network
 import Network.URI
 import Test.Hspec
 import Test.QuickCheck
---import Network.HTTP.Types.URI
+import Test.QuickCheck.Gen
+import Network.HTTP.Types.URI
+import System.Random
 
 import Data.Torrent.InfoHashSpec ()
 import Data.Torrent.ProgressSpec ()
@@ -39,9 +44,27 @@ instance Arbitrary AnnounceQuery where
 baseURI :: URI
 baseURI = fromJust $ parseURI "http://a"
 
+parseUriQuery :: URI -> [(Text, Text)]
+parseUriQuery = filterMaybes . parseQueryText . BC.pack . uriQuery
+  where
+    filterMaybes :: [(a, Maybe b)] -> [(a, b)]
+    filterMaybes = catMaybes . L.map f
+      where
+        f (a, Nothing) = Nothing
+        f (a, Just b ) = Just (a, b)
+
+test = do
+  let q = unGen arbitrary (mkStdGen 0) 0
+  print $ renderAnnounceQuery baseURI q
+  print $ parseUriQuery $ renderAnnounceQuery baseURI q
+
 spec :: Spec
 spec = do
   describe "Announce" $ do
-    return ()
+    before test $
+      it "properly url encoded" $ property $ \ q ->
+      parseAnnounceQuery (parseUriQuery (renderAnnounceQuery baseURI q))
+        `shouldBe` Right q
+
   describe "Scrape" $ do
     return ()