f8f6d14 · typeable/req

git.iko.soy/typeable/req

Use ‘modern-uri’ for URL parsing

Dropped functions ‘parseUrlHttp’, ‘parseUrlHttps’, and ‘parseUrl’. Instead we now have ‘useHttpURI’, ‘useHttpsURI’, and ‘useURI’ take ‘URI’s from ‘modern-uri’ as their argument. You first parse your URL with the ‘modern-uri’ package and then pass it to those functions. This allows us to work with typed URI representations and seamlessly convert them to something ‘req’ can work with. As a side effect basic auth from the ‘URI’s is now taken into consideration. In the future we may also start to respect fragments if ‘http-client’ starts to support this.

commitf8f6d14fd63391bdcbdadbc2f92466329b2edcf8 authormrkkrp <markkarpov92@gmail.com> dateSat 2 Nov 2019, 20:26 (7 years ago) parentefbe326

4 files changed+217−141

compare with master

unifiedsplit

CHANGELOG.md+10−1 Network/HTTP/Req.hs+90−53 pure-tests/Network/HTTP/ReqSpec.hs+115−87 req.cabal+2

CHANGELOG.md+10−1

@@ -1,4 +1,13 @@

1−## Unreleased

1+## Req 3.0.0

3+* Dropped functions `parseUrlHttp`, `parseUrlHttps`, and `parseUrl`. Instead

4+ we now have `useHttpURI`, `useHttpsURI`, and `useURI` take `URI`s from

5+ `modern-uri` as their argument. You first parse your URL with the

6+ `modern-uri` package and then pass it to those functions. This allows us

7+ to work with typed URI representations and seamlessly convert them to

8+ something `req` can work with. As a side effect basic auth from the `URI`s

9+ is now taken into consideration. In the future we may also start to

10+ respect fragments if `http-client` starts to support this.

211

312* Dropped support for GHC 8.2 and older.

413

Network/HTTP/Req.hs+90−53

@@ -95,8 +95,10 @@

9595{-# LANGUAGE FlexibleInstances #-}

9696{-# LANGUAGE GeneralizedNewtypeDeriving #-}

9797{-# LANGUAGE KindSignatures #-}

98+{-# LANGUAGE LambdaCase #-}

9899{-# LANGUAGE MultiParamTypeClasses #-}

99100{-# LANGUAGE OverloadedStrings #-}

101+{-# LANGUAGE QuasiQuotes #-}

100102{-# LANGUAGE RankNTypes #-}

101103{-# LANGUAGE RecordWildCards #-}

102104{-# LANGUAGE ScopedTypeVariables #-}

@@ -137,9 +139,9 @@ module Network.HTTP.Req

137139 , https

138140 , (/~)

139141 , (/:)

140− , parseUrlHttp

141− , parseUrlHttps

142− , parseUrl

142+ , useHttpURI

143+ , useHttpsURI

144+ , useURI

143145 -- ** Body

144146 -- $body

145147 , NoReqBody (..)

@@ -221,7 +223,7 @@ import Data.Data (Data)

221223import Data.Function (on)

222224import Data.IORef

223225import Data.Kind (Constraint, Type)

224−import Data.List (nubBy)

226+import Data.List (nubBy, foldl')

225227import Data.List.NonEmpty (NonEmpty (..))

226228import Data.Maybe (fromMaybe)

227229import Data.Proxy

@@ -231,6 +233,7 @@ import Data.Typeable (Typeable)

231233import GHC.Generics

232234import GHC.TypeLits

233235import System.IO.Unsafe (unsafePerformIO)

236+import Text.URI (URI)

234237import Web.HttpApiData (ToHttpApiData (..))

235238import qualified Blaze.ByteString.Builder as BB

236239import qualified Data.Aeson as A

@@ -238,15 +241,15 @@ import qualified Data.ByteString as B

238241import qualified Data.ByteString.Lazy as BL

239242import qualified Data.CaseInsensitive as CI

240243import qualified Data.List.NonEmpty as NE

241−import qualified Data.Text as T

242244import qualified Data.Text.Encoding as T

243−import qualified Data.Text.Read as TR

244245import qualified Network.Connection as NC

245246import qualified Network.HTTP.Client as L

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

247248import qualified Network.HTTP.Client.MultipartFormData as LM

248249import qualified Network.HTTP.Client.TLS as L

249250import qualified Network.HTTP.Types as Y

251+import qualified Text.URI as URI

252+import qualified Text.URI.QQ as QQ

250253import qualified Web.Authenticate.OAuth as OAuth

251254

252255----------------------------------------------------------------------------

@@ -311,6 +314,7 @@ import qualified Web.Authenticate.OAuth as OAuth

311314-- > import GHC.Generics

312315-- > import Network.HTTP.Req

313316-- > import qualified Data.ByteString.Char8 as B

317+-- > import qualified Text.URI as URI

314318--

315319-- We will be making requests against the <https://httpbin.org> service.

316320--

@@ -369,7 +373,8 @@ import qualified Web.Authenticate.OAuth as OAuth

369373-- > main = runReq defaultHttpConfig $ do

370374-- > -- This is an example of what to do when URL is given dynamically. Of

371375-- > -- course in a real application you may not want to use 'fromJust'.

372−-- > let (url, options) = fromJust (parseUrlHttps "https://httpbin.org/get?foo=bar")

376+-- > uri <- URI.mkURI "https://httpbin.org/get?foo=bar"

377+-- > let (url, options) = fromJust (useHttpsURI uri)

373378-- > response <- req GET url NoReqBody jsonResponse $

374379-- > "from" =: (15 :: Int) <>

375380-- > "to" =: (67 :: Int) <>

@@ -797,8 +802,7 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where

797802-- $url

798803--

799804-- We use 'Url's which are correct by construction, see 'Url'. To build a

800−-- 'Url' from a 'ByteString', use 'parseUrlHttp', 'parseUrlHttps', or

801−-- generic 'parseUrl'.

805+-- 'Url' from a 'URI', use 'useHttpURI', 'useHttpsURI', or generic 'useURI'.

802806

803807-- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https'

804808-- specifying the scheme and host at the same time. Then use the @('/~')@

@@ -859,59 +863,92 @@ infixl 5 /:

859863(/:) :: Url scheme -> Text -> Url scheme

860864(/:) = (/~)

861865

862−-- | The 'parseUrlHttp' function provides an alternative method to get 'Url'

863−-- (possibly with some 'Option's) from a 'ByteString'. This is useful when

864−-- you are given a URL to query dynamically and don't know it beforehand.

865−-- The function parses 'ByteString' because it's the correct type to

866−-- represent a URL, as 'Url' cannot contain characters outside of ASCII

867−-- range, thus we can consider every character a 'Data.Word.Word8' value.

866+-- | The 'useHttpURI' function provides an alternative method to get 'Url'

867+-- (possibly with some 'Option's) from a 'URI'. This is useful when you are

868+-- given a URL to query dynamically and don't know it beforehand.

868869--

869−-- This function only parses 'Url' (scheme, host, path) and optional query

870−-- parameters that are returned as 'Option'. It does not parse method name

871−-- or authentication info from given 'ByteString'.

870+-- This function expects the scheme to be “http” and host to be present.

872871--

873−-- This function expected scheme to be “http”.

872+-- @since 3.0.0

874873

875−parseUrlHttp :: ByteString -> Maybe (Url 'Http, Option scheme)

876−parseUrlHttp url' = do

877− url <- B.stripPrefix "http://" url'

878− (host :| path, option) <- parseUrlHelper url

879− return (foldl (/:) (http host) path, option)

874+useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)

875+useHttpURI uri = do

876+ guard (URI.uriScheme uri == Just [QQ.scheme|http|])

877+ urlHead <- http <$> uriHost uri

878+ let url = case URI.uriPath uri of

879+ Nothing -> urlHead

880+ Just (_, xs) ->

881+ foldl' (/:) urlHead (URI.unRText <$> NE.toList xs)

882+ return (url, uriOptions uri)

880883

881−-- | Just like 'parseUrlHttp', but expects the “https” scheme.

884+-- | Just like 'useHttpURI', but expects the “https” scheme.

885+--

886+-- @since 3.0.0

882887

883−parseUrlHttps :: ByteString -> Maybe (Url 'Https, Option scheme)

884−parseUrlHttps url' = do

885− url <- B.stripPrefix "https://" url'

886− (host :| path, option) <- parseUrlHelper url

887− return (foldl (/:) (https host) path, option)

888+useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)

889+useHttpsURI uri = do

890+ guard (URI.uriScheme uri == Just [QQ.scheme|https|])

891+ urlHead <- https <$> uriHost uri

892+ let url = case URI.uriPath uri of

893+ Nothing -> urlHead

894+ Just (_, xs) ->

895+ foldl' (/:) urlHead (URI.unRText <$> NE.toList xs)

896+ return (url, uriOptions uri)

888897

889898-- | A more general URI parsing function that can be used when scheme is not

890899-- known beforehand.

891900--

892−-- @since 1.2.1

893−

894−parseUrl

895− :: ByteString

896− -> Maybe (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))

897−parseUrl url = Left <$> parseUrlHttp url <|> Right <$> parseUrlHttps url

898−

899−-- | Get host\/collection of path pieces and possibly query parameters

900−-- already converted to 'Option'. This function is not public.

901−

902−parseUrlHelper :: ByteString -> Maybe (NonEmpty Text, Option scheme)

903−parseUrlHelper url = do

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

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

906− p' :| ps <- NE.nonEmpty (Y.decodePathSegments path')

907− (p, port') <-

908− case T.break (== ':') p' of

909− (x, "") -> return (x, mempty)

910− (x, prt) ->

911− case TR.decimal (T.drop 1 prt) of

912− Right (prt',"") -> return (x, port prt')

913− _ -> Nothing

914− return (p :| ps, query <> port')

901+-- @since 3.0.0

902+

903+useURI

904+ :: URI

905+ -> Maybe (Either (Url 'Http, Option scheme0)

906+ (Url 'Https, Option scheme1))

907+useURI uri =

908+ (Left <$> useHttpURI uri) <|> (Right <$> useHttpsURI uri)

909+

910+-- | An internal helper function to extract host from a 'URI'.

911+

912+uriHost :: URI -> Maybe Text

913+uriHost uri = case URI.uriAuthority uri of

914+ Left _ -> Nothing

915+ Right URI.Authority {..} ->

916+ Just (URI.unRText authHost)

917+

918+-- | An internal helper function to extract 'Option's from a 'URI'.

919+

920+uriOptions :: forall scheme. URI -> Option scheme

921+uriOptions uri = mconcat

922+ [ auth

923+ , query

924+ , port'

925+ -- , fragment'

926+ ]

927+ where

928+ (auth, port') =

929+ case URI.uriAuthority uri of

930+ Left _ -> (mempty, mempty)

931+ Right URI.Authority {..} ->

932+ let auth0 = case authUserInfo of

933+ Nothing -> mempty

934+ Just URI.UserInfo {..} ->

935+ let username = T.encodeUtf8 (URI.unRText uiUsername)

936+ password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword

937+ in basicAuthUnsafe username password

938+ port0 = case authPort of

939+ Nothing -> mempty

940+ Just port'' -> port (fromIntegral port'')

941+ in (auth0, port0)

942+ query =

943+ let liftQueryParam = \case

944+ URI.QueryFlag t -> queryFlag (URI.unRText t)

945+ URI.QueryParam k v -> URI.unRText k =: URI.unRText v

946+ in mconcat (liftQueryParam <$> URI.uriQuery uri)

947+ -- TODO Blocked on upstream: https://github.com/snoyberg/http-client/issues/424

948+ -- fragment' =

949+ -- case URI.uriFragment uri of

950+ -- Nothing -> mempty

951+ -- Just fragment'' -> fragment (URI.unRText fragment'')

915952

916953instance RequestComponent (Url scheme) where

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

pure-tests/Network/HTTP/ReqSpec.hs+115−87

@@ -2,8 +2,10 @@

22{-# LANGUAGE DataKinds #-}

33{-# LANGUAGE DeriveGeneric #-}

44{-# LANGUAGE FlexibleInstances #-}

5+{-# LANGUAGE LambdaCase #-}

56{-# LANGUAGE NoMonomorphismRestriction #-}

67{-# LANGUAGE OverloadedStrings #-}

8+{-# LANGUAGE QuasiQuotes #-}

79{-# LANGUAGE RankNTypes #-}

810{-# LANGUAGE RecordWildCards #-}

911{-# LANGUAGE ScopedTypeVariables #-}

@@ -14,10 +16,12 @@ module Network.HTTP.ReqSpec

1416where

1517

1618import Control.Exception (throwIO)

19+import Control.Monad

1720import Control.Retry

1821import Data.Aeson (ToJSON (..))

1922import Data.ByteString (ByteString)

20−import Data.Maybe (isNothing, fromJust)

23+import Data.Either (isRight)

24+import Data.Maybe (isNothing, fromJust, fromMaybe)

2125import Data.Proxy

2226import Data.Text (Text)

2327import Data.Time

@@ -26,17 +30,21 @@ import Network.HTTP.Req

2630import Test.Hspec

2731import Test.Hspec.Core.Spec (SpecM)

2832import Test.QuickCheck

33+import Text.URI (URI)

2934import qualified Blaze.ByteString.Builder as BB

3035import qualified Data.Aeson as A

3136import qualified Data.ByteString as B

3237import qualified Data.ByteString.Char8 as B8

3338import qualified Data.ByteString.Lazy as BL

3439import qualified Data.CaseInsensitive as CI

40+import qualified Data.List.NonEmpty as NE

3541import qualified Data.Text as T

3642import qualified Data.Text.Encoding as T

3743import qualified Network.HTTP.Client as L

3844import qualified Network.HTTP.Types as Y

3945import qualified Network.HTTP.Types.Header as Y

46+import qualified Text.URI as URI

47+import qualified Text.URI.QQ as QQ

4048

4149#if !MIN_VERSION_base(4,13,0)

4250import Data.Semigroup ((<>))

@@ -104,67 +112,70 @@ spec = do

104112 request <- req_ GET url' NoReqBody mempty

105113 L.host request `shouldBe` urlEncode host

106114 L.path request `shouldBe` encodePathPieces pieces

107− describe "parseUrlHttp" $ do

115+

116+ describe "useHttpURI" $ do

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

109− parseUrlHttp "https://httpbin.org" `shouldSatisfy` isNothing

110− it "parses correct URLs" $

111− property $ \host mport' pieces queryParams -> do

112− let (url', path, queryString) =

113− assembleUrl Http host mport' pieces queryParams

114− (url'', options) = fromJust (parseUrlHttp url')

115− request <- req_ GET url'' NoReqBody options

116− L.host request `shouldBe` urlEncode (unHost host)

117− L.port request `shouldBe` maybe 80 getNonNegative mport'

118− L.path request `shouldBe` path

119− L.queryString request `shouldBe` queryString

120− it "rejects gibberish in port component" $ do

121− parseUrlHttp "http://my-site.com:bob/far" `shouldSatisfy` isNothing

122− parseUrlHttp "http://my-site.com:7001uh/api" `shouldSatisfy` isNothing

123− parseUrlHttp "http://my-site.com:/bar" `shouldSatisfy` isNothing

124− describe "parseUrlHttps" $ do

118+ property $ \uri ->

119+ when (URI.uriScheme uri /= Just [QQ.scheme|http|]) $

120+ useHttpURI uri `shouldSatisfy` isNothing

121+ it "accepts correct URLs" $

122+ property $ \uri' -> do

123+ unless (isRight (URI.uriAuthority uri')) discard

124+ let uri = uri' { URI.uriScheme = Just [QQ.scheme|http|] }

125+ (url', options) = fromJust (useHttpURI uri)

126+ request <- req_ GET url' NoReqBody options

127+ L.host request `shouldBe` uriHost uri

128+ L.port request `shouldBe` uriPort 80 uri

129+ L.path request `shouldBe` uriPath uri

130+ L.queryString request `shouldBe` uriQuery uri

131+ lookup "Authorization" (L.requestHeaders request)

132+ `shouldBe` uriBasicAuth uri

133+ describe "useHttpsURI" $ do

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

126− parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing

135+ property $ \uri ->

136+ when (URI.uriScheme uri /= Just [QQ.scheme|https|]) $

137+ useHttpsURI uri `shouldSatisfy` isNothing

127138 it "parses correct URLs" $

128− property $ \host mport' pieces queryParams -> do

129− let (url', path, queryString) =

130− assembleUrl Https host mport' pieces queryParams

131− (url'', options) = fromJust (parseUrlHttps url')

132− request <- req_ GET url'' NoReqBody options

133− L.host request `shouldBe` urlEncode (unHost host)

134− L.port request `shouldBe` maybe 443 getNonNegative mport'

135− L.path request `shouldBe` path

136− L.queryString request `shouldBe` queryString

137− it "rejects gibberish in port component" $ do

138− parseUrlHttp "https://my-site.com:bob/far" `shouldSatisfy` isNothing

139− parseUrlHttp "https://my-site.com:7001uh/api" `shouldSatisfy` isNothing

140− parseUrlHttp "https://my-site.com:/bar" `shouldSatisfy` isNothing

141− describe "parseUrl" $ do

139+ property $ \uri' -> do

140+ unless (isRight (URI.uriAuthority uri')) discard

141+ let uri = uri' { URI.uriScheme = Just [QQ.scheme|https|] }

142+ (url', options) = fromJust (useHttpsURI uri)

143+ request <- req_ GET url' NoReqBody options

144+ L.host request `shouldBe` uriHost uri

145+ L.port request `shouldBe` uriPort 443 uri

146+ L.path request `shouldBe` uriPath uri

147+ L.queryString request `shouldBe` uriQuery uri

148+ lookup "Authorization" (L.requestHeaders request)

149+ `shouldBe` uriBasicAuth uri

150+ describe "useURI" $ do

142151 it "does not recognize non-http and non-https schemes" $

143− parseUrl "ftp://httpbin.org" `shouldSatisfy` isNothing

144− it "parses correct http URLs" $

145− property $ \host mport' pieces queryParams -> do

146− let (url', path, queryString) =

147− assembleUrl Http host mport' pieces queryParams

148− Left (url'', options) = fromJust (parseUrl url')

149− request <- req_ GET url'' NoReqBody options

150− L.host request `shouldBe` urlEncode (unHost host)

151− L.port request `shouldBe` maybe 80 getNonNegative mport'

152− L.path request `shouldBe` path

153− L.queryString request `shouldBe` queryString

154− it "parses correct https URLs" $

155− property $ \host mport' pieces queryParams -> do

156− let (url', path, queryString) =

157− assembleUrl Https host mport' pieces queryParams

158− Right (url'', options) = fromJust (parseUrl url')

159− request <- req_ GET url'' NoReqBody options

160− L.host request `shouldBe` urlEncode (unHost host)

161− L.port request `shouldBe` maybe 443 getNonNegative mport'

162− L.path request `shouldBe` path

163− L.queryString request `shouldBe` queryString

164− it "rejects gibberish in port component" $ do

165− parseUrl "http://my-site.com:bob/far" `shouldSatisfy` isNothing

166− parseUrl "https://my-site.com:7001uh/api" `shouldSatisfy` isNothing

167− parseUrl "http://my-site.com:/bar" `shouldSatisfy` isNothing

152+ property $ \uri ->

153+ when ((URI.uriScheme uri /= Just [QQ.scheme|http|] &&

154+ (URI.uriScheme uri /= Just [QQ.scheme|https|]))) $

155+ useURI uri `shouldSatisfy` isNothing

156+ it "parses correct URLs" $

157+ property $ \uri' -> do

158+ unless (isRight (URI.uriAuthority uri')) discard

159+ let uriHttp = uri' { URI.uriScheme = Just [QQ.scheme|http|] }

160+ uriHttps = uri' { URI.uriScheme = Just [QQ.scheme|https|] }

161+ requestHttp <-

162+ let Left (url', options) = fromJust (useURI uriHttp)

163+ in req_ GET url' NoReqBody options

164+ requestHttps <-

165+ let Right (url', options) = fromJust (useURI uriHttps)

166+ in req_ GET url' NoReqBody options

167+ L.host requestHttp `shouldBe` uriHost uriHttp

168+ L.host requestHttps `shouldBe` uriHost uriHttps

169+ L.port requestHttp `shouldBe` uriPort 80 uriHttp

170+ L.port requestHttps `shouldBe` uriPort 443 uriHttps

171+ L.path requestHttp `shouldBe` uriPath uriHttp

172+ L.path requestHttps `shouldBe` uriPath uriHttps

173+ L.queryString requestHttp `shouldBe` uriQuery uriHttp

174+ L.queryString requestHttps `shouldBe` uriQuery uriHttps

175+ lookup "Authorization" (L.requestHeaders requestHttp)

176+ `shouldBe` uriBasicAuth uriHttp

177+ lookup "Authorization" (L.requestHeaders requestHttps)

178+ `shouldBe` uriBasicAuth uriHttps

168179

169180 describe "bodies" $ do

170181 describe "NoReqBody" $

@@ -228,24 +239,22 @@ spec = do

228239 property $ \username password -> do

229240 request <- req_ GET url NoReqBody (basicAuth username password)

230241 lookup "Authorization" (L.requestHeaders request) `shouldBe`

231− pure (basicAuthHeader username password)

242+ Just (basicAuthHeader username password)

232243 it "overwrites manual setting of header" $

233244 property $ \username password value -> do

234245 request0 <- req_ GET url NoReqBody

235246 (basicAuth username password <> header "Authorization" value)

236247 request1 <- req_ GET url NoReqBody

237248 (header "Authorization" value <> basicAuth username password)

238− let result = basicAuthHeader username password

239− lookup "Authorization" (L.requestHeaders request0) `shouldBe`

240− pure result

241− lookup "Authorization" (L.requestHeaders request1) `shouldBe`

242− pure result

249+ let result = Just (basicAuthHeader username password)

250+ lookup "Authorization" (L.requestHeaders request0) `shouldBe` result

251+ lookup "Authorization" (L.requestHeaders request1) `shouldBe` result

243252 it "left auth option wins" $

244253 property $ \username0 password0 username1 password1 -> do

245254 request <- req_ GET url NoReqBody

246255 (basicAuth username0 password0 <> basicAuth username1 password1)

247256 lookup "Authorization" (L.requestHeaders request) `shouldBe`

248− pure (basicAuthHeader username0 password0)

257+ Just (basicAuthHeader username0 password0)

249258 describe "oAuth2Bearer" $ do

250259 it "sets Authorization header to correct value" $

251260 property $ \token -> do

@@ -447,28 +456,47 @@ urlEncode = Y.urlEncode False . T.encodeUtf8

447456encodePathPieces :: [Text] -> ByteString

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

449458

450−-- | Assemble a URL.

451−

452−assembleUrl

453− :: Scheme -- ^ Scheme

454− -> Host -- ^ Host

455− -> Maybe (NonNegative Int) -- ^ Port

456− -> [Text] -- ^ Path pieces

457− -> QueryParams -- ^ Query parameters

458− -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string

459−assembleUrl scheme' (Host host') mport' pathPieces (QueryParams queryParams) =

460− (scheme <> host <> port' <> path <> queryString, path, queryString)

461− where

462− scheme = case scheme' of

463− Http -> "http://"

464− Https -> "https://"

465− host = urlEncode host'

466− port' =

467− case mport' of

468− Nothing -> ""

469− Just (NonNegative x) -> ":" <> B8.pack (show x)

470− path = encodePathPieces pathPieces

471− queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)

459+-- | Get host from a 'URI'. This function is not total.

460+

461+uriHost :: URI -> ByteString

462+uriHost uri = fromJust $

463+ urlEncode . URI.unRText . URI.authHost

464+ <$> either (const Nothing) Just (URI.uriAuthority uri)

465+

466+-- | Get part from a 'URI' defaulting to the provided value.

467+

468+uriPort :: Int -> URI -> Int

469+uriPort def uri = maybe def (fromIntegral) $

470+ either (const Nothing) Just (URI.uriAuthority uri) >>= URI.authPort

471+

472+-- | Get path from 'URI'.

473+

474+uriPath :: URI -> ByteString

475+uriPath uri = fromMaybe "" $ do

476+ (_, xs) <- URI.uriPath uri

477+ (return . encodePathPieces . fmap URI.unRText . NE.toList) xs

478+

479+-- | Get query string from 'URI'.

480+

481+uriQuery :: URI -> ByteString

482+uriQuery uri = do

483+ let liftQueryParam = \case

484+ URI.QueryFlag t -> (URI.unRText t, Nothing)

485+ URI.QueryParam k v -> (URI.unRText k, Just (URI.unRText v))

486+ Y.renderQuery True (Y.queryTextToQuery (liftQueryParam <$> (URI.uriQuery uri)))

487+

488+-- | Predict the headrs that should be set if the given 'URI' has username

489+-- and password in it.

490+

491+uriBasicAuth :: URI -> Maybe ByteString

492+uriBasicAuth uri = do

493+ auth <- either (const Nothing) Just (URI.uriAuthority uri)

494+ URI.UserInfo {..} <- URI.authUserInfo auth

495+ let username = T.encodeUtf8 (URI.unRText uiUsername)

496+ password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword

497+ return (basicAuthHeader username password)

498+

499+-- | Render a query as lazy 'BL.ByteString'.

472500

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

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

req.cabal+2

@@ -38,6 +38,7 @@ library

3838 , http-client >= 0.5 && < 0.7

3939 , http-client-tls >= 0.3.2 && < 0.4

4040 , http-types >= 0.8 && < 10.0

41+ , modern-uri >= 0.3 && < 0.4

4142 , monad-control >= 1.0 && < 1.1

4243 , mtl >= 2.0 && < 3.0

4344 , retry >= 0.8 && < 0.9

@@ -72,6 +73,7 @@ test-suite pure-tests

7273 , hspec-core >= 2.0 && < 3.0

7374 , http-client >= 0.5 && < 0.7

7475 , http-types >= 0.8 && < 10.0

76+ , modern-uri >= 0.3 && < 0.4

7577 , mtl >= 2.0 && < 3.0

7678 , req

7779 , retry >= 0.8 && < 0.9