b234fd4 · typeable/req

git.iko.soy/typeable/req

on master help sign in

Make parsing functions recognize port numbers (#21)

b234fd4Mark Karpov9 years ago

CHANGELOG.md+3

compare with master

unifiedsplit

@@ -1,5 +1,8 @@

1## Req 0.3.0

3+* Made URL parsing functions `parseUrlHttp` and `parseUrlHttps` recognize

4+ port numbers.

3* Improved wording in the documentation and `README.md`.

6* Improved wording in the documentation and `README.md`.

5## Req 0.2.0

8## Req 0.2.0

Network/HTTP/Req.hs+11−2

@@ -237,7 +237,9 @@ import qualified Data.ByteString as B

237import qualified Data.ByteString.Lazy as BL

238import qualified Data.CaseInsensitive as CI

239import qualified Data.List.NonEmpty as NE

240+import qualified Data.Text as T

240import qualified Data.Text.Encoding as T

241import qualified Data.Text.Encoding as T

242+import qualified Data.Text.Read as TR

241import qualified Network.Connection as NC

243import qualified Network.Connection as NC

242import qualified Network.HTTP.Client as L

244import qualified Network.HTTP.Client as L

243import qualified Network.HTTP.Client.Internal as LI

245import qualified Network.HTTP.Client.Internal as LI

@@ -744,8 +746,15 @@ parseUrlHelper :: ByteString -> Maybe (NonEmpty Text, Option scheme)

744parseUrlHelper url = do

746parseUrlHelper url = do

745 let (path', query') = B.break (== 0x3f) url

747 let (path', query') = B.break (== 0x3f) url

746 query = mconcat (uncurry queryParam <$> Y.parseQueryText query')

748 query = mconcat (uncurry queryParam <$> Y.parseQueryText query')

747− path <- NE.nonEmpty (Y.decodePathSegments path')

749+ p' :| ps <- NE.nonEmpty (Y.decodePathSegments path')

748− return (path, query)

750+ (p, port') <-

751+ case T.break (== ':') p' of

752+ (x, "") -> return (x, mempty)

753+ (x, prt) ->

754+ case TR.decimal (T.drop 1 prt) of

755+ Right (prt',"") -> return (x, port prt')

756+ _ -> Nothing

757+ return (p :| ps, query <> port')

749

758

750instance RequestComponent (Url scheme) where

759instance RequestComponent (Url scheme) where

751 getRequestMod (Url scheme segments) = Endo $ \x ->

760 getRequestMod (Url scheme segments) = Endo $ \x ->

pure-tests/Network/HTTP/ReqSpec.hs+47−18

@@ -113,28 +113,36 @@ spec = do

113 it "does not recognize non-http schemes" $

114 parseUrlHttp "https://httpbin.org" `shouldSatisfy` isNothing

115 it "parses correct URLs" $

116− property $ \host pieces queryParams ->

116+ property $ \host mport' pieces queryParams -> do

117− not (T.null host) && wellFormed queryParams ==> do

118 let (url', path, queryString) =

117 let (url', path, queryString) =

119− assembleUrl Http host pieces queryParams

118+ assembleUrl Http host mport' pieces queryParams

120 (url'', options) = fromJust (parseUrlHttp url')

119 (url'', options) = fromJust (parseUrlHttp url')

121 request <- req_ GET url'' NoReqBody options

120 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'

123 L.path request `shouldBe` path

124 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

125 describe "parseUrlHttps" $ do

129 describe "parseUrlHttps" $ do

126 it "does not recognize non-https schemes" $

130 it "does not recognize non-https schemes" $

127 parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing

131 parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing

128 it "parses correct URLs" $

132 it "parses correct URLs" $

129− property $ \host pieces queryParams ->

133+ property $ \host mport' pieces queryParams -> do

130− not (T.null host) && wellFormed queryParams ==> do

131 let (url', path, queryString) =

134 let (url', path, queryString) =

132− assembleUrl Https host pieces queryParams

135+ assembleUrl Https host mport' pieces queryParams

133 (url'', options) = fromJust (parseUrlHttps url')

136 (url'', options) = fromJust (parseUrlHttps url')

134 request <- req_ GET url'' NoReqBody options

137 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'

136 L.path request `shouldBe` path

140 L.path request `shouldBe` path

137 L.queryString request `shouldBe` queryString

141 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

138

146

139 describe "bodies" $ do

147 describe "bodies" $ do

140 describe "NoReqBody" $

148 describe "NoReqBody" $

@@ -359,6 +367,27 @@ instance Arbitrary Day where

359instance Arbitrary DiffTime where

367instance Arbitrary DiffTime where

360 arbitrary = secondsToDiffTime <$> arbitrary

368 arbitrary = secondsToDiffTime <$> arbitrary

361

369

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+

362----------------------------------------------------------------------------

391----------------------------------------------------------------------------

363-- Helpers

392-- Helpers

364

393

@@ -392,32 +421,32 @@ urlEncode = Y.urlEncode False . T.encodeUtf8

392encodePathPieces :: [Text] -> ByteString

421encodePathPieces :: [Text] -> ByteString

393encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments

422encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments

394

423

395−-- | Assemble entire URL.

424+-- | Assemble a URL.

396

425

397assembleUrl

426assembleUrl

398 :: Scheme -- ^ Scheme

427 :: Scheme -- ^ Scheme

399− -> Text -- ^ Host

428+ -> Host -- ^ Host

429+ -> Maybe (NonNegative Int) -- ^ Port

400 -> [Text] -- ^ Path pieces

430 -> [Text] -- ^ Path pieces

401− -> [(Text, Maybe Text)] -- ^ Query parameters

431+ -> QueryParams -- ^ Query parameters

402 -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string

432 -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string

403−assembleUrl scheme' host' pathPieces queryParams =

433+assembleUrl scheme' (Host host') mport' pathPieces (QueryParams queryParams) =

404− (scheme <> host <> path <> queryString, path, queryString)

434+ (scheme <> host <> port' <> path <> queryString, path, queryString)

405 where

435 where

406 scheme = case scheme' of

436 scheme = case scheme' of

407 Http -> "http://"

437 Http -> "http://"

408 Https -> "https://"

438 Https -> "https://"

409 host = urlEncode host'

439 host = urlEncode host'

440+ port' =

441+ case mport' of

442+ Nothing -> ""

443+ Just (NonNegative x) -> ":" <> B8.pack (show x)

410 path = encodePathPieces pathPieces

444 path = encodePathPieces pathPieces

411 queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)

445 queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)

412

446

413renderQuery :: [(Text, Maybe Text)] -> BL.ByteString

447renderQuery :: [(Text, Maybe Text)] -> BL.ByteString

414renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery

448renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery

415

449

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−

421-- | Convert collection of query parameters to 'FormUrlEncodedParam' thing.

450-- | Convert collection of query parameters to 'FormUrlEncodedParam' thing.

422

451

423formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam

452formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam