diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-27 13:35:41 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-27 13:35:41 +0400 |
commit | 27cf6fbeeb19572a58a71ca7cf080aeea82d0cb8 (patch) | |
tree | eca0e79ab636031934a68102c5516088d94b2d59 | |
parent | 2bd418d50f7f0dd5ff1db7e65a7727ed22edb4fe (diff) |
More informative ParamParseFailure
-rw-r--r-- | bittorrent.cabal | 3 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Message.hs | 15 | ||||
-rw-r--r-- | tests/Network/BitTorrent/Tracker/MessageSpec.hs | 27 |
3 files changed, 35 insertions, 10 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal index dbc9d96a..6d2c7896 100644 --- a/bittorrent.cabal +++ b/bittorrent.cabal | |||
@@ -63,7 +63,7 @@ library | |||
63 | -- , Network.BitTorrent.Tracker.HTTP | 63 | -- , Network.BitTorrent.Tracker.HTTP |
64 | -- , Network.BitTorrent.Tracker.UDP | 64 | -- , Network.BitTorrent.Tracker.UDP |
65 | -- , Network.BitTorrent.Exchange | 65 | -- , Network.BitTorrent.Exchange |
66 | -- , Network.BitTorrent.Exchange.Protocol | 66 | , Network.BitTorrent.Exchange.Protocol |
67 | -- , Network.BitTorrent.DHT | 67 | -- , Network.BitTorrent.DHT |
68 | -- , Network.BitTorrent.DHT.Protocol | 68 | -- , Network.BitTorrent.DHT.Protocol |
69 | -- , Network.BitTorrent.Sessions | 69 | -- , Network.BitTorrent.Sessions |
@@ -155,6 +155,7 @@ test-suite spec | |||
155 | , directory | 155 | , directory |
156 | , filepath | 156 | , filepath |
157 | , time | 157 | , time |
158 | , random | ||
158 | 159 | ||
159 | , aeson | 160 | , aeson |
160 | , cereal | 161 | , cereal |
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs index 53d7a946..3447a367 100644 --- a/src/Network/BitTorrent/Tracker/Message.hs +++ b/src/Network/BitTorrent/Tracker/Message.hs | |||
@@ -155,7 +155,7 @@ data AnnounceQuery = AnnounceQuery | |||
155 | 155 | ||
156 | -- | If not specified, the request is regular periodic request. | 156 | -- | If not specified, the request is regular periodic request. |
157 | , reqEvent :: Maybe Event | 157 | , reqEvent :: Maybe Event |
158 | } deriving (Show, Typeable) | 158 | } deriving (Show, Eq, Typeable) |
159 | 159 | ||
160 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceQuery) | 160 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceQuery) |
161 | 161 | ||
@@ -233,8 +233,9 @@ data QueryParam | |||
233 | deriving (Show, Eq, Ord, Enum) | 233 | deriving (Show, Eq, Ord, Enum) |
234 | 234 | ||
235 | data ParamParseFailure | 235 | data ParamParseFailure |
236 | = Missing QueryParam -- ^ param not found in query string; | 236 | = Missing QueryParam -- ^ param not found in query string; |
237 | | Invalid QueryParam -- ^ param present but not valid. | 237 | | Invalid QueryParam Text -- ^ param present but not valid. |
238 | deriving (Show, Eq) | ||
238 | 239 | ||
239 | type ParamResult = Either ParamParseFailure | 240 | type ParamResult = Either ParamParseFailure |
240 | 241 | ||
@@ -271,11 +272,11 @@ parseAnnounceQuery params = AnnounceQuery | |||
271 | where | 272 | where |
272 | withError e = maybe (Left e) Right | 273 | withError e = maybe (Left e) Right |
273 | reqParam param p = withError (Missing param) . L.lookup (paramName param) | 274 | reqParam param p = withError (Missing param) . L.lookup (paramName param) |
274 | >=> withError (Invalid param) . p | 275 | >=> \x -> withError (Invalid param x) (p x) |
275 | 276 | ||
276 | optParam param p ps | 277 | optParam param p ps |
277 | | Just x <- L.lookup (paramName param) ps | 278 | | Just x <- L.lookup (paramName param) ps |
278 | = pure <$> withError (Invalid param) (p x) | 279 | = pure <$> withError (Invalid param x) (p x) |
279 | | otherwise = pure Nothing | 280 | | otherwise = pure Nothing |
280 | 281 | ||
281 | progress = undefined | 282 | progress = undefined |
@@ -426,8 +427,8 @@ invalidOffset = 150 | |||
426 | -- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Response_Codes> | 427 | -- <https://wiki.theory.org/BitTorrent_Tracker_Protocol#Response_Codes> |
427 | -- | 428 | -- |
428 | paramFailureCode :: ParamParseFailure -> Int | 429 | paramFailureCode :: ParamParseFailure -> Int |
429 | paramFailureCode (Missing param) = missingOffset + fromEnum param | 430 | paramFailureCode (Missing param ) = missingOffset + fromEnum param |
430 | paramFailureCode (Invalid param) = invalidOffset + fromEnum param | 431 | paramFailureCode (Invalid param _) = invalidOffset + fromEnum param |
431 | 432 | ||
432 | {----------------------------------------------------------------------- | 433 | {----------------------------------------------------------------------- |
433 | Scrape message | 434 | Scrape message |
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 | ||
4 | import Control.Applicative | 4 | import Control.Applicative |
5 | import Data.BEncode as BE | 5 | import Data.BEncode as BE |
6 | import Data.ByteString.Char8 as BC | ||
6 | import Data.ByteString.Lazy as BL | 7 | import Data.ByteString.Lazy as BL |
8 | import Data.List as L | ||
7 | import Data.Maybe | 9 | import Data.Maybe |
8 | import Data.Word | 10 | import Data.Word |
11 | import Data.Text | ||
9 | import Network | 12 | import Network |
10 | import Network.URI | 13 | import Network.URI |
11 | import Test.Hspec | 14 | import Test.Hspec |
12 | import Test.QuickCheck | 15 | import Test.QuickCheck |
13 | --import Network.HTTP.Types.URI | 16 | import Test.QuickCheck.Gen |
17 | import Network.HTTP.Types.URI | ||
18 | import System.Random | ||
14 | 19 | ||
15 | import Data.Torrent.InfoHashSpec () | 20 | import Data.Torrent.InfoHashSpec () |
16 | import Data.Torrent.ProgressSpec () | 21 | import Data.Torrent.ProgressSpec () |
@@ -39,9 +44,27 @@ instance Arbitrary AnnounceQuery where | |||
39 | baseURI :: URI | 44 | baseURI :: URI |
40 | baseURI = fromJust $ parseURI "http://a" | 45 | baseURI = fromJust $ parseURI "http://a" |
41 | 46 | ||
47 | parseUriQuery :: URI -> [(Text, Text)] | ||
48 | parseUriQuery = 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 | |||
56 | test = do | ||
57 | let q = unGen arbitrary (mkStdGen 0) 0 | ||
58 | print $ renderAnnounceQuery baseURI q | ||
59 | print $ parseUriQuery $ renderAnnounceQuery baseURI q | ||
60 | |||
42 | spec :: Spec | 61 | spec :: Spec |
43 | spec = do | 62 | spec = 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 () |