packages feed

req 2.1.0 → 3.0.0

raw patch · 7 files changed

+249/−172 lines, 7 filesdep +modern-uridep ~base

Dependencies added: modern-uri

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,3 +1,16 @@+## Req 3.0.0++* 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.++* Dropped support for GHC 8.2 and older.+ ## Req 2.1.0  * Dropped support for GHC 7.10.
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2016–2018 Mark Karpov+Copyright © 2016–present Mark Karpov  All rights reserved. 
Network/HTTP/Req.hs view
@@ -1,6 +1,6 @@ -- | -- Module      :  Network.HTTP.Req--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -95,8 +95,10 @@ {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE LambdaCase                 #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE QuasiQuotes                #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE RecordWildCards            #-} {-# LANGUAGE ScopedTypeVariables        #-}@@ -137,9 +139,9 @@   , https   , (/~)   , (/:)-  , parseUrlHttp-  , parseUrlHttps-  , parseUrl+  , useHttpURI+  , useHttpsURI+  , useURI     -- ** Body     -- $body   , NoReqBody (..)@@ -220,8 +222,8 @@ import Data.Data (Data) import Data.Function (on) import Data.IORef-import Data.Kind (Constraint)-import Data.List (nubBy)+import Data.Kind (Constraint, Type)+import Data.List (nubBy, foldl') import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe) import Data.Proxy@@ -231,6 +233,7 @@ import GHC.Generics import GHC.TypeLits import System.IO.Unsafe (unsafePerformIO)+import Text.URI (URI) import Web.HttpApiData (ToHttpApiData (..)) import qualified Blaze.ByteString.Builder     as BB import qualified Data.Aeson                   as A@@ -238,15 +241,15 @@ import qualified Data.ByteString.Lazy         as BL import qualified Data.CaseInsensitive         as CI import qualified Data.List.NonEmpty           as NE-import qualified Data.Text                    as T import qualified Data.Text.Encoding           as T-import qualified Data.Text.Read               as TR import qualified Network.Connection           as NC import qualified Network.HTTP.Client          as L import qualified Network.HTTP.Client.Internal as LI import qualified Network.HTTP.Client.MultipartFormData as LM import qualified Network.HTTP.Client.TLS      as L import qualified Network.HTTP.Types           as Y+import qualified Text.URI                     as URI+import qualified Text.URI.QQ                  as QQ import qualified Web.Authenticate.OAuth       as OAuth  ----------------------------------------------------------------------------@@ -311,6 +314,7 @@ -- > import GHC.Generics -- > import Network.HTTP.Req -- > import qualified Data.ByteString.Char8 as B+-- > import qualified Text.URI as URI -- -- We will be making requests against the <https://httpbin.org> service. --@@ -369,7 +373,8 @@ -- > main = runReq defaultHttpConfig $ do -- >   -- This is an example of what to do when URL is given dynamically. Of -- >   -- course in a real application you may not want to use 'fromJust'.--- >   let (url, options) = fromJust (parseUrlHttps "https://httpbin.org/get?foo=bar")+-- >   uri <- URI.mkURI "https://httpbin.org/get?foo=bar"+-- >   let (url, options) = fromJust (useHttpsURI uri) -- >   response <- req GET url NoReqBody jsonResponse $ -- >     "from" =: (15 :: Int)           <> -- >     "to"   =: (67 :: Int)           <>@@ -797,8 +802,7 @@ -- $url -- -- We use 'Url's which are correct by construction, see 'Url'. To build a--- 'Url' from a 'ByteString', use 'parseUrlHttp', 'parseUrlHttps', or--- generic 'parseUrl'.+-- 'Url' from a 'URI', use 'useHttpURI', 'useHttpsURI', or generic 'useURI'.  -- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https' -- specifying the scheme and host at the same time. Then use the @('/~')@@@ -853,66 +857,99 @@ Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)  -- | Type-constrained version of @('/~')@ to remove ambiguity in the cases--- when next URL piece is a 'Text' literal.+-- when next URL piece is a 'Data.Text.Text' literal.  infixl 5 /: (/:) :: Url scheme -> Text -> Url scheme (/:) = (/~) --- | The 'parseUrlHttp' function provides an alternative method to get 'Url'--- (possibly with some 'Option's) from a 'ByteString'. This is useful when--- you are given a URL to query dynamically and don't know it beforehand.--- The function parses 'ByteString' because it's the correct type to--- represent a URL, as 'Url' cannot contain characters outside of ASCII--- range, thus we can consider every character a 'Data.Word.Word8' value.+-- | The 'useHttpURI' function provides an alternative method to get 'Url'+-- (possibly with some 'Option's) from a 'URI'. This is useful when you are+-- given a URL to query dynamically and don't know it beforehand. ----- This function only parses 'Url' (scheme, host, path) and optional query--- parameters that are returned as 'Option'. It does not parse method name--- or authentication info from given 'ByteString'.+-- This function expects the scheme to be “http” and host to be present. ----- This function expected scheme to be “http”.+-- @since 3.0.0 -parseUrlHttp :: ByteString -> Maybe (Url 'Http, Option scheme)-parseUrlHttp url' = do-  url <- B.stripPrefix "http://" url'-  (host :| path, option) <- parseUrlHelper url-  return (foldl (/:) (http host) path, option)+useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)+useHttpURI uri = do+  guard (URI.uriScheme uri == Just [QQ.scheme|http|])+  urlHead <- http <$> uriHost uri+  let url = case URI.uriPath uri of+        Nothing -> urlHead+        Just (_, xs) ->+          foldl' (/:) urlHead (URI.unRText <$> NE.toList xs)+  return (url, uriOptions uri) --- | Just like 'parseUrlHttp', but expects the “https” scheme.+-- | Just like 'useHttpURI', but expects the “https” scheme.+--+-- @since 3.0.0 -parseUrlHttps :: ByteString -> Maybe (Url 'Https, Option scheme)-parseUrlHttps url' = do-  url <- B.stripPrefix "https://" url'-  (host :| path, option) <- parseUrlHelper url-  return (foldl (/:) (https host) path, option)+useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)+useHttpsURI uri = do+  guard (URI.uriScheme uri == Just [QQ.scheme|https|])+  urlHead <- https <$> uriHost uri+  let url = case URI.uriPath uri of+        Nothing -> urlHead+        Just (_, xs) ->+          foldl' (/:) urlHead (URI.unRText <$> NE.toList xs)+  return (url, uriOptions uri)  -- | A more general URI parsing function that can be used when scheme is not -- known beforehand. ----- @since 1.2.1+-- @since 3.0.0 -parseUrl-  :: ByteString-  -> Maybe (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))-parseUrl url = Left <$> parseUrlHttp url <|> Right <$> parseUrlHttps url+useURI+  :: URI+  -> Maybe (Either (Url 'Http, Option scheme0)+                   (Url 'Https, Option scheme1))+useURI uri =+  (Left <$> useHttpURI uri) <|> (Right <$> useHttpsURI uri) --- | Get host\/collection of path pieces and possibly query parameters--- already converted to 'Option'. This function is not public.+-- | An internal helper function to extract host from a 'URI'. -parseUrlHelper :: ByteString -> Maybe (NonEmpty Text, Option scheme)-parseUrlHelper url = do-  let (path', query') = B.break (== 0x3f) url-      query = mconcat (uncurry queryParam <$> Y.parseQueryText query')-  p' :| ps <- NE.nonEmpty (Y.decodePathSegments path')-  (p, port') <--    case T.break (== ':') p' of-      (x, "") -> return (x, mempty)-      (x, prt) ->-        case TR.decimal (T.drop 1 prt) of-          Right (prt',"") -> return (x, port prt')-          _               -> Nothing-  return (p :| ps, query <> port')+uriHost :: URI -> Maybe Text+uriHost uri = case URI.uriAuthority uri of+  Left _ -> Nothing+  Right URI.Authority {..} ->+    Just (URI.unRText authHost) +-- | An internal helper function to extract 'Option's from a 'URI'.++uriOptions :: forall scheme. URI -> Option scheme+uriOptions uri = mconcat+  [ auth+  , query+  , port'+  -- , fragment'+  ]+  where+    (auth, port') =+      case URI.uriAuthority uri of+        Left _ -> (mempty, mempty)+        Right URI.Authority {..} ->+          let auth0 = case authUserInfo of+                Nothing -> mempty+                Just URI.UserInfo {..} ->+                  let username = T.encodeUtf8 (URI.unRText uiUsername)+                      password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword+                  in basicAuthUnsafe username password+              port0 = case authPort of+                Nothing -> mempty+                Just port'' -> port (fromIntegral port'')+          in (auth0, port0)+    query =+      let liftQueryParam = \case+            URI.QueryFlag t -> queryFlag (URI.unRText t)+            URI.QueryParam k v -> URI.unRText k =: URI.unRText v+      in mconcat (liftQueryParam <$> URI.uriQuery uri)+    -- TODO Blocked on upstream: https://github.com/snoyberg/http-client/issues/424+    -- fragment' =+    --   case URI.uriFragment uri of+    --     Nothing -> mempty+    --     Just fragment'' -> fragment (URI.unRText fragment'')+ instance RequestComponent (Url scheme) where   getRequestMod (Url scheme segments) = Endo $ \x ->     let (host :| path) = NE.reverse segments in@@ -1616,7 +1653,7 @@   -- | The associated type is the type of body that can be extracted from an   -- instance of 'HttpResponse'. -  type HttpResponseBody response :: *+  type HttpResponseBody response :: Type    -- | The method describes how to get the underlying 'L.Response' record. 
README.md view
@@ -99,13 +99,13 @@ ## Motivation and Req vs other libraries  *This section is my opinion and it contains criticisms of other well-known-libraries. If you're user/fan of one of these libraries, please remember not-to react aggressively and respect the fact that I may have different views-on API design from yours.*+libraries. If you're a user/fan of one of these libraries, please remember+not to react aggressively and respect the fact that I may have different+views on API design from yours.* -I have spent time to write the library because sending HTTP requests is such-a common thing and still there is no high-level library for that in Haskell-that I could use with pleasure. I'll explain why.+I have spent time to write the library because sending HTTP requests is a+common need, but there is no high-level library for that in Haskell that I+could use with pleasure. I'll explain why.  First of all, there is `http-client` and `http-client-tls`. They just work. I have no issues with the libraries except that they are too low-level for@@ -123,9 +123,9 @@ just adds `conduit`-powered functions to perform requests and allows to use global implicit `Manager` (Req does the same). If I tried to frame what exactly I don't like about `http-conduit` in words, then it would be “the-way requests are constructed”. You set, set, set instead of *being forced*-to declare necessary bits and *being allowed* to declare optional bits in a-way that their combination is certainly valid. Also, with `http-conduit` you+way requests are constructed”. You *set* parameters instead of *being+forced* to declare necessary bits and *being allowed* to declare optional+bits in a way that their combination is valid. Also, with `http-conduit` you parse request from a string without the protection of TH that otherwise saves the day as in Yesod. @@ -152,17 +152,9 @@ for sessions, but the point is that they are just too inconvenient for common tasks. -It's funny that one client I worked for had to invent his own little wrapper-around `http-client` just because he could not possibly use `wreq` and-`http-client` and friends were too low-level. The previous paragraph is-extracted from a talk with a Haskell developer who works for that client. I-thought to myself “something is wrong with HTTP client libraries in Haskell-if they had to make a wrapper”.--What else? I used `servant-client` a couple of times but the amount of-boilerplate it requires is frightening. If you have several query-parameters, and you use just one of them, good luck passing lots of-`Nothing`s.+I used `servant-client` a couple of times but the amount of boilerplate it+requires is frightening. If you have several query parameters, and you use+just one of them, you'll have to pass lots of `Nothing`s.  ## Unsolved problems @@ -205,6 +197,6 @@  ## License -Copyright © 2016–2019 Mark Karpov+Copyright © 2016–present Mark Karpov  Distributed under BSD 3 clause license.
httpbin-tests/Network/HTTP/ReqSpec.hs view
@@ -13,7 +13,6 @@ import Control.Monad.Reader import Control.Monad.Trans.Control import Data.Aeson (Value (..), ToJSON (..), object, (.=))-import Data.Monoid ((<>)) import Data.Proxy import Data.Text (Text) import Network.HTTP.Req@@ -29,6 +28,10 @@ import qualified Network.HTTP.Client  as L import qualified Network.HTTP.Client.MultipartFormData as LM import qualified Network.HTTP.Types   as Y++#if !MIN_VERSION_base(4,13,0)+import Data.Semigroup ((<>))+#endif  spec :: Spec spec = do
pure-tests/Network/HTTP/ReqSpec.hs view
@@ -2,8 +2,10 @@ {-# LANGUAGE DataKinds                 #-} {-# LANGUAGE DeriveGeneric             #-} {-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE LambdaCase                #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE QuasiQuotes               #-} {-# LANGUAGE RankNTypes                #-} {-# LANGUAGE RecordWildCards           #-} {-# LANGUAGE ScopedTypeVariables       #-}@@ -14,11 +16,12 @@ where  import Control.Exception (throwIO)+import Control.Monad import Control.Retry import Data.Aeson (ToJSON (..)) import Data.ByteString (ByteString)-import Data.Maybe (isNothing, fromJust)-import Data.Monoid ((<>))+import Data.Either (isRight)+import Data.Maybe (isNothing, fromJust, fromMaybe) import Data.Proxy import Data.Text (Text) import Data.Time@@ -27,18 +30,26 @@ import Test.Hspec import Test.Hspec.Core.Spec (SpecM) import Test.QuickCheck+import Text.URI (URI) import qualified Blaze.ByteString.Builder as BB import qualified Data.Aeson               as A import qualified Data.ByteString          as B import qualified Data.ByteString.Char8    as B8 import qualified Data.ByteString.Lazy     as BL import qualified Data.CaseInsensitive     as CI+import qualified Data.List.NonEmpty       as NE import qualified Data.Text                as T import qualified Data.Text.Encoding       as T import qualified Network.HTTP.Client      as L import qualified Network.HTTP.Types       as Y import qualified Network.HTTP.Types.Header as Y+import qualified Text.URI                 as URI+import qualified Text.URI.QQ              as QQ +#if !MIN_VERSION_base(4,13,0)+import Data.Semigroup ((<>))+#endif+ spec :: Spec spec = do @@ -101,67 +112,70 @@           request <- req_ GET url' NoReqBody mempty           L.host request `shouldBe` urlEncode host           L.path request `shouldBe` encodePathPieces pieces-    describe "parseUrlHttp" $ do++    describe "useHttpURI" $ do       it "does not recognize non-http schemes" $-        parseUrlHttp "https://httpbin.org" `shouldSatisfy` isNothing-      it "parses correct URLs" $-        property $ \host mport' pieces queryParams -> do-          let (url', path, queryString) =-                assembleUrl Http host mport' pieces queryParams-              (url'', options) = fromJust (parseUrlHttp url')-          request <- req_ GET url'' NoReqBody options-          L.host        request `shouldBe` urlEncode (unHost host)-          L.port        request `shouldBe` maybe 80 getNonNegative mport'-          L.path        request `shouldBe` path-          L.queryString request `shouldBe` queryString-      it "rejects gibberish in port component" $ do-        parseUrlHttp "http://my-site.com:bob/far" `shouldSatisfy` isNothing-        parseUrlHttp "http://my-site.com:7001uh/api" `shouldSatisfy` isNothing-        parseUrlHttp "http://my-site.com:/bar" `shouldSatisfy` isNothing-    describe "parseUrlHttps" $ do+        property $ \uri ->+          when (URI.uriScheme uri /= Just [QQ.scheme|http|]) $+            useHttpURI uri `shouldSatisfy` isNothing+      it "accepts correct URLs" $+        property $ \uri' -> do+          unless (isRight (URI.uriAuthority uri')) discard+          let uri = uri' { URI.uriScheme = Just [QQ.scheme|http|] }+              (url', options) = fromJust (useHttpURI uri)+          request <- req_ GET url' NoReqBody options+          L.host request `shouldBe` uriHost uri+          L.port request `shouldBe` uriPort 80 uri+          L.path request `shouldBe` uriPath uri+          L.queryString request `shouldBe` uriQuery uri+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` uriBasicAuth uri+    describe "useHttpsURI" $ do       it "does not recognize non-https schemes" $-        parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing+        property $ \uri ->+          when (URI.uriScheme uri /= Just [QQ.scheme|https|]) $+            useHttpsURI uri `shouldSatisfy` isNothing       it "parses correct URLs" $-        property $ \host mport' pieces queryParams -> do-          let (url', path, queryString) =-                assembleUrl Https host mport' pieces queryParams-              (url'', options) = fromJust (parseUrlHttps url')-          request <- req_ GET url'' NoReqBody options-          L.host        request `shouldBe` urlEncode (unHost host)-          L.port        request `shouldBe` maybe 443 getNonNegative mport'-          L.path        request `shouldBe` path-          L.queryString request `shouldBe` queryString-      it "rejects gibberish in port component" $ do-        parseUrlHttp "https://my-site.com:bob/far" `shouldSatisfy` isNothing-        parseUrlHttp "https://my-site.com:7001uh/api" `shouldSatisfy` isNothing-        parseUrlHttp "https://my-site.com:/bar" `shouldSatisfy` isNothing-    describe "parseUrl" $ do+        property $ \uri' -> do+          unless (isRight (URI.uriAuthority uri')) discard+          let uri = uri' { URI.uriScheme = Just [QQ.scheme|https|] }+              (url', options) = fromJust (useHttpsURI uri)+          request <- req_ GET url' NoReqBody options+          L.host request `shouldBe` uriHost uri+          L.port request `shouldBe` uriPort 443 uri+          L.path request `shouldBe` uriPath uri+          L.queryString request `shouldBe` uriQuery uri+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` uriBasicAuth uri+    describe "useURI" $ do       it "does not recognize non-http and non-https schemes" $-        parseUrl "ftp://httpbin.org" `shouldSatisfy` isNothing-      it "parses correct http URLs" $-        property $ \host mport' pieces queryParams -> do-          let (url', path, queryString) =-                assembleUrl Http host mport' pieces queryParams-              Left (url'', options) = fromJust (parseUrl url')-          request <- req_ GET url'' NoReqBody options-          L.host        request `shouldBe` urlEncode (unHost host)-          L.port        request `shouldBe` maybe 80 getNonNegative mport'-          L.path        request `shouldBe` path-          L.queryString request `shouldBe` queryString-      it "parses correct https URLs" $-        property $ \host mport' pieces queryParams -> do-          let (url', path, queryString) =-                assembleUrl Https host mport' pieces queryParams-              Right (url'', options) = fromJust (parseUrl url')-          request <- req_ GET url'' NoReqBody options-          L.host        request `shouldBe` urlEncode (unHost host)-          L.port        request `shouldBe` maybe 443 getNonNegative mport'-          L.path        request `shouldBe` path-          L.queryString request `shouldBe` queryString-      it "rejects gibberish in port component" $ do-        parseUrl "http://my-site.com:bob/far" `shouldSatisfy` isNothing-        parseUrl "https://my-site.com:7001uh/api" `shouldSatisfy` isNothing-        parseUrl "http://my-site.com:/bar" `shouldSatisfy` isNothing+        property $ \uri ->+          when ((URI.uriScheme uri /= Just [QQ.scheme|http|] &&+                (URI.uriScheme uri /= Just [QQ.scheme|https|]))) $+            useURI uri `shouldSatisfy` isNothing+      it "parses correct URLs" $+        property $ \uri' -> do+          unless (isRight (URI.uriAuthority uri')) discard+          let uriHttp = uri' { URI.uriScheme = Just [QQ.scheme|http|] }+              uriHttps = uri' { URI.uriScheme = Just [QQ.scheme|https|] }+          requestHttp <-+            let Left (url', options) = fromJust (useURI uriHttp)+            in req_ GET url' NoReqBody options+          requestHttps <-+            let Right (url', options) = fromJust (useURI uriHttps)+            in req_ GET url' NoReqBody options+          L.host requestHttp `shouldBe` uriHost uriHttp+          L.host requestHttps `shouldBe` uriHost uriHttps+          L.port requestHttp `shouldBe` uriPort 80 uriHttp+          L.port requestHttps `shouldBe` uriPort 443 uriHttps+          L.path requestHttp `shouldBe` uriPath uriHttp+          L.path requestHttps `shouldBe` uriPath uriHttps+          L.queryString requestHttp `shouldBe` uriQuery uriHttp+          L.queryString requestHttps `shouldBe` uriQuery uriHttps+          lookup "Authorization" (L.requestHeaders requestHttp)+            `shouldBe` uriBasicAuth uriHttp+          lookup "Authorization" (L.requestHeaders requestHttps)+            `shouldBe` uriBasicAuth uriHttps    describe "bodies" $ do     describe "NoReqBody" $@@ -225,24 +239,22 @@         property $ \username password -> do           request <- req_ GET url NoReqBody (basicAuth username password)           lookup "Authorization" (L.requestHeaders request) `shouldBe`-            pure (basicAuthHeader username password)+            Just (basicAuthHeader username password)       it "overwrites manual setting of header" $         property $ \username password value -> do           request0 <- req_ GET url NoReqBody             (basicAuth username password <> header "Authorization" value)           request1 <- req_ GET url NoReqBody             (header "Authorization" value <> basicAuth username password)-          let result = basicAuthHeader username password-          lookup "Authorization" (L.requestHeaders request0) `shouldBe`-            pure result-          lookup "Authorization" (L.requestHeaders request1) `shouldBe`-            pure result+          let result = Just (basicAuthHeader username password)+          lookup "Authorization" (L.requestHeaders request0) `shouldBe` result+          lookup "Authorization" (L.requestHeaders request1) `shouldBe` result       it "left auth option wins" $         property $ \username0 password0 username1 password1 -> do           request <- req_ GET url NoReqBody             (basicAuth username0 password0 <> basicAuth username1 password1)           lookup "Authorization" (L.requestHeaders request) `shouldBe`-            pure (basicAuthHeader username0 password0)+            Just (basicAuthHeader username0 password0)     describe "oAuth2Bearer" $ do       it "sets Authorization header to correct value" $         property $ \token -> do@@ -444,28 +456,47 @@ encodePathPieces :: [Text] -> ByteString encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments --- | Assemble a URL.+-- | Get host from a 'URI'. This function is not total. -assembleUrl-  :: Scheme            -- ^ Scheme-  -> Host              -- ^ Host-  -> Maybe (NonNegative Int) -- ^ Port-  -> [Text]            -- ^ Path pieces-  -> QueryParams       -- ^ Query parameters-  -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string-assembleUrl scheme' (Host host') mport' pathPieces (QueryParams queryParams) =-  (scheme <> host <> port' <> path <> queryString, path, queryString)-  where-    scheme = case scheme' of-      Http  -> "http://"-      Https -> "https://"-    host        = urlEncode host'-    port'       =-      case mport' of-        Nothing -> ""-        Just (NonNegative x) -> ":" <> B8.pack (show x)-    path        = encodePathPieces pathPieces-    queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)+uriHost :: URI -> ByteString+uriHost uri = fromJust $+  urlEncode . URI.unRText . URI.authHost+    <$> either (const Nothing) Just (URI.uriAuthority uri)++-- | Get part from a 'URI' defaulting to the provided value.++uriPort :: Int -> URI -> Int+uriPort def uri = maybe def (fromIntegral) $+  either (const Nothing) Just (URI.uriAuthority uri) >>= URI.authPort++-- | Get path from 'URI'.++uriPath :: URI -> ByteString+uriPath uri = fromMaybe "" $ do+  (_, xs) <- URI.uriPath uri+  (return . encodePathPieces . fmap URI.unRText . NE.toList) xs++-- | Get query string from 'URI'.++uriQuery :: URI -> ByteString+uriQuery uri = do+  let liftQueryParam = \case+        URI.QueryFlag t -> (URI.unRText t, Nothing)+        URI.QueryParam k v -> (URI.unRText k, Just (URI.unRText v))+  Y.renderQuery True (Y.queryTextToQuery (liftQueryParam <$> (URI.uriQuery uri)))++-- | Predict the headrs that should be set if the given 'URI' has username+-- and password in it.++uriBasicAuth :: URI -> Maybe ByteString+uriBasicAuth uri = do+  auth <- either (const Nothing) Just (URI.uriAuthority uri)+  URI.UserInfo {..} <- URI.authUserInfo auth+  let username = T.encodeUtf8 (URI.unRText uiUsername)+      password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword+  return (basicAuthHeader username password)++-- | Render a query as lazy 'BL.ByteString'.  renderQuery :: [(Text, Maybe Text)] -> BL.ByteString renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery
req.cabal view
@@ -1,7 +1,7 @@ name:                 req-version:              2.1.0+version:              3.0.0 cabal-version:        1.18-tested-with:          GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5+tested-with:          GHC==8.4.4, GHC==8.6.5, GHC==8.8.1 license:              BSD3 license-file:         LICENSE.md author:               Mark Karpov <markkarpov92@gmail.com>@@ -29,7 +29,7 @@ library   build-depends:      aeson            >= 0.9    && < 1.5                     , authenticate-oauth >= 1.5  && < 1.7-                    , base             >= 4.9    && < 5.0+                    , base             >= 4.11   && < 5.0                     , blaze-builder    >= 0.3    && < 0.5                     , bytestring       >= 0.10.8 && < 0.11                     , case-insensitive >= 0.2    && < 1.3@@ -38,11 +38,12 @@                     , http-client      >= 0.5    && < 0.7                     , http-client-tls  >= 0.3.2  && < 0.4                     , http-types       >= 0.8    && < 10.0+                    , modern-uri       >= 0.3    && < 0.4                     , monad-control    >= 1.0    && < 1.1                     , mtl              >= 2.0    && < 3.0                     , retry            >= 0.8    && < 0.9                     , text             >= 0.2    && < 1.3-                    , time             >= 1.2    && < 1.9+                    , time             >= 1.2    && < 1.10                     , transformers     >= 0.4    && < 0.6                     , transformers-base   exposed-modules:    Network.HTTP.Req@@ -55,7 +56,6 @@                       -Wincomplete-record-updates                       -Wincomplete-uni-patterns                       -Wnoncanonical-monad-instances-                      -Wnoncanonical-monadfail-instances   default-language:   Haskell2010  test-suite pure-tests@@ -65,7 +65,7 @@   type:               exitcode-stdio-1.0   build-depends:      QuickCheck       >= 2.7    && < 3.0                     , aeson            >= 0.9    && < 1.5-                    , base             >= 4.9    && < 5.0+                    , base             >= 4.11   && < 5.0                     , blaze-builder    >= 0.3    && < 0.5                     , bytestring       >= 0.10.8 && < 0.11                     , case-insensitive >= 0.2    && < 1.3@@ -73,11 +73,12 @@                     , hspec-core       >= 2.0    && < 3.0                     , http-client      >= 0.5    && < 0.7                     , http-types       >= 0.8    && < 10.0+                    , modern-uri       >= 0.3    && < 0.4                     , mtl              >= 2.0    && < 3.0                     , req                     , retry            >= 0.8    && < 0.9                     , text             >= 0.2    && < 1.3-                    , time             >= 1.2    && < 1.9+                    , time             >= 1.2    && < 1.10   build-tools:        hspec-discover   >= 2.0    && < 3.0   if flag(dev)     ghc-options:      -O0 -Wall -Werror@@ -92,7 +93,7 @@   type:               exitcode-stdio-1.0   build-depends:      QuickCheck       >= 2.7    && < 3.0                     , aeson            >= 0.9    && < 1.5-                    , base             >= 4.9    && < 5.0+                    , base             >= 4.11   && < 5.0                     , bytestring       >= 0.10.8 && < 0.11                     , hspec            >= 2.0    && < 3.0                     , http-client      >= 0.5    && < 0.7