@@ -113,28 +113,36 @@ spec = do
113113 it "does not recognize non-http schemes" $
114114 parseUrlHttp "https://httpbin.org" `shouldSatisfy` isNothing
115115 it "parses correct URLs" $
116− property $ \host pieces queryParams ->
117− not (T.null host) && wellFormed queryParams ==> do
116+ property $ \host mport' pieces queryParams -> do
118117 let (url', path, queryString) =
119− assembleUrl Http host pieces queryParams
118+ assembleUrl Http host mport' pieces queryParams
120119 (url'', options) = fromJust (parseUrlHttp url')
121120 request <- req_ GET url'' NoReqBody options
122− L.host request `shouldBe` urlEncode host
121+ L.host request `shouldBe` urlEncode (unHost host)
122+ L.port request `shouldBe` maybe 80 getNonNegative mport'
123123 L.path request `shouldBe` path
124124 L.queryString request `shouldBe` queryString
125+ it "rejects gibberish in port component" $ do
126+ parseUrlHttp "http://my-site.com:bob/far" `shouldSatisfy` isNothing
127+ parseUrlHttp "http://my-site.com:7001uh/api" `shouldSatisfy` isNothing
128+ parseUrlHttp "http://my-site.com:/bar" `shouldSatisfy` isNothing
125129 describe "parseUrlHttps" $ do
126130 it "does not recognize non-https schemes" $
127131 parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing
128132 it "parses correct URLs" $
129− property $ \host pieces queryParams ->
130− not (T.null host) && wellFormed queryParams ==> do
133+ property $ \host mport' pieces queryParams -> do
131134 let (url', path, queryString) =
132− assembleUrl Https host pieces queryParams
135+ assembleUrl Https host mport' pieces queryParams
133136 (url'', options) = fromJust (parseUrlHttps url')
134137 request <- req_ GET url'' NoReqBody options
135− L.host request `shouldBe` urlEncode host
138+ L.host request `shouldBe` urlEncode (unHost host)
139+ L.port request `shouldBe` maybe 443 getNonNegative mport'
136140 L.path request `shouldBe` path
137141 L.queryString request `shouldBe` queryString
142+ it "rejects gibberish in port component" $ do
143+ parseUrlHttp "https://my-site.com:bob/far" `shouldSatisfy` isNothing
144+ parseUrlHttp "https://my-site.com:7001uh/api" `shouldSatisfy` isNothing
145+ parseUrlHttp "https://my-site.com:/bar" `shouldSatisfy` isNothing
138146
139147 describe "bodies" $ do
140148 describe "NoReqBody" $
@@ -359,6 +367,27 @@ instance Arbitrary Day where
359367instance Arbitrary DiffTime where
360368 arbitrary = secondsToDiffTime <$> arbitrary
361369
370+----------------------------------------------------------------------------
371+-- Helper types
372+
373+-- | A wrapper to generate correct hosts.
374+
375+newtype Host = Host { unHost :: Text }
376+ deriving (Eq, Show)
377+
378+instance Arbitrary Host where
379+ arbitrary = Host . T.pack <$> listOf1 (arbitrary `suchThat` (/= ':'))
380+
381+-- | A wrapper to generate correct query parameters.
382+
383+newtype QueryParams = QueryParams [(Text, Maybe Text)]
384+ deriving (Eq, Show)
385+
386+instance Arbitrary QueryParams where
387+ arbitrary = QueryParams <$> (arbitrary `suchThat` wellFormed)
388+ where
389+ wellFormed = all (not . T.null . fst)
390+
362391----------------------------------------------------------------------------
363392-- Helpers
364393
@@ -392,32 +421,32 @@ urlEncode = Y.urlEncode False . T.encodeUtf8
392421encodePathPieces :: [Text] -> ByteString
393422encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments
394423
395−-- | Assemble entire URL.
424+-- | Assemble a URL.
396425
397426assembleUrl
398427 :: Scheme -- ^ Scheme
399− -> Text -- ^ Host
428+ -> Host -- ^ Host
429+ -> Maybe (NonNegative Int) -- ^ Port
400430 -> [Text] -- ^ Path pieces
401− -> [(Text, Maybe Text)] -- ^ Query parameters
431+ -> QueryParams -- ^ Query parameters
402432 -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string
403−assembleUrl scheme' host' pathPieces queryParams =
404− (scheme <> host <> path <> queryString, path, queryString)
433+assembleUrl scheme' (Host host') mport' pathPieces (QueryParams queryParams) =
434+ (scheme <> host <> port' <> path <> queryString, path, queryString)
405435 where
406436 scheme = case scheme' of
407437 Http -> "http://"
408438 Https -> "https://"
409439 host = urlEncode host'
440+ port' =
441+ case mport' of
442+ Nothing -> ""
443+ Just (NonNegative x) -> ":" <> B8.pack (show x)
410444 path = encodePathPieces pathPieces
411445 queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)
412446
413447renderQuery :: [(Text, Maybe Text)] -> BL.ByteString
414448renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery
415449
416−-- | Check if collection of query params is well-formed.
417−
418−wellFormed :: [(Text, Maybe Text)] -> Bool
419−wellFormed = all (not . T.null . fst)
420−
421450-- | Convert collection of query parameters to 'FormUrlEncodedParam' thing.
422451
423452formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam