@@ -1,20 +1,9 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
31{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−{-# LANGUAGE DeriveGeneric #-}
6−{-# LANGUAGE DeriveLift #-}
7−{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
92{-# LANGUAGE LambdaCase #-}
10−{-# LANGUAGE MultiParamTypeClasses #-}
113{-# LANGUAGE OverloadedStrings #-}
124{-# LANGUAGE QuasiQuotes #-}
13−{-# LANGUAGE RankNTypes #-}
145{-# LANGUAGE RecordWildCards #-}
156{-# LANGUAGE RoleAnnotations #-}
16−{-# LANGUAGE ScopedTypeVariables #-}
17−{-# LANGUAGE StandaloneDeriving #-}
187{-# LANGUAGE TemplateHaskellQuotes #-}
198{-# LANGUAGE TypeFamilies #-}
209{-# LANGUAGE UndecidableInstances #-}
@@ -161,6 +150,7 @@ module Network.HTTP.Req
161150 -- *** Headers
162151 header,
163152 attachHeader,
153+ headerRedacted,
164154
165155 -- *** Cookies
166156 -- $cookies
@@ -207,74 +197,78 @@ module Network.HTTP.Req
207197
208198 -- * Other
209199 HttpException (..),
200+ isStatusCodeException,
210201 CanHaveBody (..),
211202 Scheme (..),
212203 )
213204where
214205
215−import qualified Blaze.ByteString.Builder as BB
206+import Blaze.ByteString.Builder qualified as BB
216207import Control.Applicative
217208import Control.Arrow (first, second)
218209import Control.Exception hiding (Handler (..), TypeError)
210+import Control.Monad (guard, void, (>=>))
219211import Control.Monad.Base
220212import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
221213import Control.Monad.IO.Class
222214import Control.Monad.IO.Unlift
223−import Control.Monad.Reader
215+import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)
224216import Control.Monad.Trans.Accum (AccumT)
225217import Control.Monad.Trans.Cont (ContT)
226218import Control.Monad.Trans.Control
227219import Control.Monad.Trans.Except (ExceptT)
228220import Control.Monad.Trans.Identity (IdentityT)
229221import Control.Monad.Trans.Maybe (MaybeT)
230−import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS
231−import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
232−import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
222+import Control.Monad.Trans.RWS.CPS qualified as RWS.CPS
223+import Control.Monad.Trans.RWS.Lazy qualified as RWS.Lazy
224+import Control.Monad.Trans.RWS.Strict qualified as RWS.Strict
233225import Control.Monad.Trans.Select (SelectT)
234−import qualified Control.Monad.Trans.State.Lazy as State.Lazy
235−import qualified Control.Monad.Trans.State.Strict as State.Strict
236−import qualified Control.Monad.Trans.Writer.CPS as Writer.CPS
237−import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
238−import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
226+import Control.Monad.Trans.State.Lazy qualified as State.Lazy
227+import Control.Monad.Trans.State.Strict qualified as State.Strict
228+import Control.Monad.Trans.Writer.CPS qualified as Writer.CPS
229+import Control.Monad.Trans.Writer.Lazy qualified as Writer.Lazy
230+import Control.Monad.Trans.Writer.Strict qualified as Writer.Strict
239231import Control.Retry
240232import Data.Aeson (FromJSON (..), ToJSON (..))
241−import qualified Data.Aeson as A
233+import Data.Aeson qualified as A
242234import Data.ByteString (ByteString)
243−import qualified Data.ByteString as B
244−import qualified Data.ByteString.Lazy as BL
245−import qualified Data.CaseInsensitive as CI
235+import Data.ByteString qualified as B
236+import Data.ByteString.Lazy qualified as BL
237+import Data.CaseInsensitive qualified as CI
246238import Data.Data (Data)
239+import Data.Default.Class (def)
247240import Data.Function (on)
248241import Data.IORef
249242import Data.Kind (Constraint, Type)
250243import Data.List (foldl', nubBy)
251244import Data.List.NonEmpty (NonEmpty (..))
252−import qualified Data.List.NonEmpty as NE
245+import Data.List.NonEmpty qualified as NE
253246import Data.Maybe (fromMaybe)
254247import Data.Proxy
255248import Data.Semigroup (Endo (..))
249+import Data.Set qualified as S
256250import Data.Text (Text)
257−import qualified Data.Text as T
258−import qualified Data.Text.Encoding as T
251+import Data.Text qualified as T
252+import Data.Text.Encoding qualified as T
259253import Data.Typeable (Typeable, cast)
260254import GHC.Generics
261255import GHC.TypeLits
262−import qualified Language.Haskell.TH as TH
263−import qualified Language.Haskell.TH.Quote as TH
264−import qualified Language.Haskell.TH.Syntax as TH
265−import qualified Network.Connection as NC
266−import qualified Network.HTTP.Client as L
267−import qualified Network.HTTP.Client.Internal as LI
268−import qualified Network.HTTP.Client.MultipartFormData as LM
269−import qualified Network.HTTP.Client.TLS as L
270−import qualified Network.HTTP.Types as Y
256+import Language.Haskell.TH qualified as TH
257+import Language.Haskell.TH.Quote qualified as TH
258+import Language.Haskell.TH.Syntax qualified as TH
259+import Network.Connection qualified as NC
260+import Network.HTTP.Client qualified as L
261+import Network.HTTP.Client.Internal qualified as LI
262+import Network.HTTP.Client.MultipartFormData qualified as LM
263+import Network.HTTP.Client.TLS qualified as L
264+import Network.HTTP.Types qualified as Y
271265import System.IO.Unsafe (unsafePerformIO)
272266import Text.URI (URI)
273−import qualified Text.URI as URI
274−import qualified Text.URI.QQ as QQ
275−import qualified Web.Authenticate.OAuth as OAuth
267+import Text.URI qualified as URI
268+import Text.URI.QQ qualified as QQ
269+import Web.Authenticate.OAuth qualified as OAuth
276270import Web.FormUrlEncoded (FromForm (..), ToForm (..))
277−import qualified Web.FormUrlEncoded as Form
271+import Web.FormUrlEncoded qualified as Form
278272import Web.HttpApiData (ToHttpApiData (..))
279273
280274----------------------------------------------------------------------------
@@ -495,7 +489,7 @@ reqCb method url body responseProxy options adjustRequest =
495489--
496490-- @since 3.7.0
497491reqHandler ::
498− MonadHttp m =>
492+ (MonadHttp m) =>
499493 -- | How to get final result from a 'L.Response'
500494 (L.Response L.BodyReader -> IO b) ->
501495 -- | 'L.Request' to perform
@@ -591,10 +585,10 @@ req' method url body options m = do
591585 withReqManager (m request)
592586
593587-- | Perform an action using the global implicit 'L.Manager' that the rest
594−-- of the library uses. This allows to reuse connections that the
588+-- of the library uses. This allows us to reuse connections that the
595589-- 'L.Manager' controls.
596−withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
597−withReqManager m = liftIO (readIORef globalManager) >>= m
590+withReqManager :: (MonadIO m) => (L.Manager -> m a) -> m a
591+withReqManager m = m globalManager
598592
599593-- | The global 'L.Manager' that 'req' uses. Here we just go with the
600594-- default settings, so users don't need to deal with this manager stuff at
@@ -607,16 +601,16 @@ withReqManager m = liftIO (readIORef globalManager) >>= m
607601-- manager. From that moment on the 'IORef' will be just reused—exactly the
608602-- behavior we want here in order to maximize connection sharing. GHC could
609603-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
610−globalManager :: IORef L.Manager
604+globalManager :: L.Manager
611605globalManager = unsafePerformIO $ do
612606 context <- NC.initConnectionContext
613607 let settings =
614608 L.mkManagerSettingsContext
615609 (Just context)
616− (NC.TLSSettingsSimple False False False)
610+ def
617611 Nothing
618612 manager <- L.newManager settings
619− newIORef manager
613+ return manager
620614{-# NOINLINE globalManager #-}
621615
622616----------------------------------------------------------------------------
@@ -636,7 +630,7 @@ globalManager = unsafePerformIO $ do
636630-- | A type class for monads that support performing HTTP requests.
637631-- Typically, you only need to define the 'handleHttpException' method
638632-- unless you want to tweak 'HttpConfig'.
639−class MonadIO m => MonadHttp m where
633+class (MonadIO m) => MonadHttp m where
640634 -- | This method describes how to deal with 'HttpException' that was
641635 -- caught by the library. One option is to re-throw it if you are OK with
642636 -- exceptions, but if you prefer working with something like
@@ -720,9 +714,8 @@ data HttpConfig = HttpConfig
720714 -- | Max length of preview fragment of response body.
721715 --
722716 -- @since 3.6.0
723− httpConfigBodyPreviewLength :: forall a. Num a => a
717+ httpConfigBodyPreviewLength :: forall a. (Num a) => a
724718 }
725− deriving (Typeable)
726719
727720-- | The default value of 'HttpConfig'.
728721--
@@ -810,27 +803,27 @@ instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where
810803 getHttpConfig = lift getHttpConfig
811804
812805-- | @since 3.10.0
813−instance MonadHttp m => MonadHttp (ContT r m) where
806+instance (MonadHttp m) => MonadHttp (ContT r m) where
814807 handleHttpException = lift . handleHttpException
815808 getHttpConfig = lift getHttpConfig
816809
817810-- | @since 3.10.0
818−instance MonadHttp m => MonadHttp (ExceptT e m) where
811+instance (MonadHttp m) => MonadHttp (ExceptT e m) where
819812 handleHttpException = lift . handleHttpException
820813 getHttpConfig = lift getHttpConfig
821814
822815-- | @since 3.10.0
823−instance MonadHttp m => MonadHttp (IdentityT m) where
816+instance (MonadHttp m) => MonadHttp (IdentityT m) where
824817 handleHttpException = lift . handleHttpException
825818 getHttpConfig = lift getHttpConfig
826819
827820-- | @since 3.10.0
828−instance MonadHttp m => MonadHttp (MaybeT m) where
821+instance (MonadHttp m) => MonadHttp (MaybeT m) where
829822 handleHttpException = lift . handleHttpException
830823 getHttpConfig = lift getHttpConfig
831824
832825-- | @since 3.10.0
833−instance MonadHttp m => MonadHttp (ReaderT r m) where
826+instance (MonadHttp m) => MonadHttp (ReaderT r m) where
834827 handleHttpException = lift . handleHttpException
835828 getHttpConfig = lift getHttpConfig
836829
@@ -850,17 +843,17 @@ instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Strict.RWST r w s m) where
850843 getHttpConfig = lift getHttpConfig
851844
852845-- | @since 3.10.0
853−instance MonadHttp m => MonadHttp (SelectT r m) where
846+instance (MonadHttp m) => MonadHttp (SelectT r m) where
854847 handleHttpException = lift . handleHttpException
855848 getHttpConfig = lift getHttpConfig
856849
857850-- | @since 3.10.0
858−instance MonadHttp m => MonadHttp (State.Lazy.StateT s m) where
851+instance (MonadHttp m) => MonadHttp (State.Lazy.StateT s m) where
859852 handleHttpException = lift . handleHttpException
860853 getHttpConfig = lift getHttpConfig
861854
862855-- | @since 3.10.0
863−instance MonadHttp m => MonadHttp (State.Strict.StateT s m) where
856+instance (MonadHttp m) => MonadHttp (State.Strict.StateT s m) where
864857 handleHttpException = lift . handleHttpException
865858 getHttpConfig = lift getHttpConfig
866859
@@ -884,7 +877,7 @@ instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Strict.WriterT w m) where
884877--
885878-- @since 0.4.0
886879runReq ::
887− MonadIO m =>
880+ (MonadIO m) =>
888881 -- | 'HttpConfig' to use
889882 HttpConfig ->
890883 -- | Computation to run
@@ -989,7 +982,7 @@ class HttpMethod a where
989982 -- | Return name of the method as a 'ByteString'.
990983 httpMethodName :: Proxy a -> ByteString
991984
992−instance HttpMethod method => RequestComponent (Tagged "method" method) where
985+instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
993986 getRequestMod _ = Endo $ \x ->
994987 x {L.method = httpMethodName (Proxy :: Proxy method)}
995988
@@ -1031,25 +1024,20 @@ instance HttpMethod method => RequestComponent (Tagged "method" method) where
10311024-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
10321025data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
10331026 -- NOTE The second value is the path segments in reversed order.
1034− deriving (Eq, Ord, Show, Data, Typeable, Generic)
1027+ deriving (Eq, Ord, Show, Data, Generic)
10351028
10361029type role Url nominal
10371030
10381031-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however
10391032-- the derived lift forgets the type of the scheme.
1040−instance Typeable scheme => TH.Lift (Url scheme) where
1033+instance (Typeable scheme) => TH.Lift (Url scheme) where
10411034 lift url =
10421035 TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of
10431036 Url Http _ -> [t|Url 'Http|]
10441037 Url Https _ -> [t|Url 'Https|]
10451038 where
10461039 liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
1047−
1048−#if MIN_VERSION_template_haskell(2,17,0)
10491040 liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
1050−#elif MIN_VERSION_template_haskell(2,16,0)
1051− liftTyped = TH.unsafeTExpCoerce . TH.lift
1052−#endif
10531041
10541042-- | Given host name, produce a 'Url' which has “http” as its scheme and
10551043-- empty path. This also sets port to @80@.
@@ -1065,7 +1053,7 @@ https = Url Https . pure
10651053-- path segment can be of any type that is an instance of 'ToHttpApiData'.
10661054infixl 5 /~
10671055
1068−(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
1056+(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme
10691057Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
10701058
10711059-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases
@@ -1253,7 +1241,7 @@ instance HttpBody NoReqBody where
12531241-- charset=utf-8\"@ value.
12541242newtype ReqBodyJson a = ReqBodyJson a
12551243
1256−instance ToJSON a => HttpBody (ReqBodyJson a) where
1244+instance (ToJSON a) => HttpBody (ReqBodyJson a) where
12571245 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)
12581246 getRequestContentType _ = pure "application/json; charset=utf-8"
12591247
@@ -1352,7 +1340,7 @@ instance HttpBody ReqBodyMultipart where
13521340-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
13531341--
13541342-- @since 0.2.0
1355−reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
1343+reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart
13561344reqBodyMultipart parts = liftIO $ do
13571345 boundary <- LM.webkitBoundary
13581346 body <- LM.renderParts boundary parts
@@ -1392,7 +1380,7 @@ type family
13921380 TypeError
13931381 ('Text "This HTTP method does not allow attaching a request body.")
13941382
1395−instance HttpBody body => RequestComponent (Tagged "body" body) where
1383+instance (HttpBody body) => RequestComponent (Tagged "body" body) where
13961384 getRequestMod (Tagged body) = Endo $ \x ->
13971385 x
13981386 { L.requestBody = getRequestBody body,
@@ -1462,7 +1450,7 @@ instance RequestComponent (Option scheme) where
14621450
14631451-- | Finalize given 'L.Request' by applying a finalizer from the given
14641452-- 'Option' (if it has any).
1465−finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
1453+finalizeRequest :: (MonadIO m) => Option scheme -> L.Request -> m L.Request
14661454finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
14671455
14681456----------------------------------------------------------------------------
@@ -1495,7 +1483,7 @@ name =: value = queryParam name (pure value)
14951483-- This operator is defined in terms of 'queryParam':
14961484--
14971485-- > queryFlag name = queryParam name (Nothing :: Maybe ())
1498−queryFlag :: QueryParam param => Text -> param
1486+queryFlag :: (QueryParam param) => Text -> param
14991487queryFlag name = queryParam name (Nothing :: Maybe ())
15001488
15011489-- | Construct query parameters from a 'ToForm' instance. This function
@@ -1525,7 +1513,7 @@ class QueryParam param where
15251513 -- 'Nothing', it won't be included at all (i.e. you create a flag this
15261514 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
15271515 -- method, because they are easier to read.
1528− queryParam :: ToHttpApiData a => Text -> Maybe a -> param
1516+ queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param
15291517
15301518 -- | Get the query parameter names and values set by 'queryParam'.
15311519 --
@@ -1559,6 +1547,14 @@ attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
15591547attachHeader name value x =
15601548 x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
15611549
1550+-- | Same as 'header', but with redacted values on print.
1551+--
1552+-- @since 3.13.0
1553+headerRedacted :: ByteString -> ByteString -> Option scheme
1554+headerRedacted name value = withRequest $ \x ->
1555+ let y = attachHeader name value x
1556+ in y {L.redactHeaders = CI.mk name `S.insert` L.redactHeaders y}
1557+
15621558----------------------------------------------------------------------------
15631559-- Request—Optional parameters—Cookies
15641560
@@ -1766,7 +1762,7 @@ ignoreResponse = Proxy
17661762newtype JsonResponse a = JsonResponse (L.Response a)
17671763 deriving (Show)
17681764
1769−instance FromJSON a => HttpResponse (JsonResponse a) where
1765+instance (FromJSON a) => HttpResponse (JsonResponse a) where
17701766 type HttpResponseBody (JsonResponse a) = a
17711767 toVanillaResponse (JsonResponse r) = r
17721768 getHttpResponse r = do
@@ -1882,14 +1878,14 @@ brReadN br n = go 0 id id
18821878
18831879-- | Get the response body.
18841880responseBody ::
1885− HttpResponse response =>
1881+ (HttpResponse response) =>
18861882 response ->
18871883 HttpResponseBody response
18881884responseBody = L.responseBody . toVanillaResponse
18891885
18901886-- | Get the response status code.
18911887responseStatusCode ::
1892− HttpResponse response =>
1888+ (HttpResponse response) =>
18931889 response ->
18941890 Int
18951891responseStatusCode =
@@ -1897,7 +1893,7 @@ responseStatusCode =
18971893
18981894-- | Get the response status message.
18991895responseStatusMessage ::
1900− HttpResponse response =>
1896+ (HttpResponse response) =>
19011897 response ->
19021898 ByteString
19031899responseStatusMessage =
@@ -1905,7 +1901,7 @@ responseStatusMessage =
19051901
19061902-- | Lookup a particular header from a response.
19071903responseHeader ::
1908− HttpResponse response =>
1904+ (HttpResponse response) =>
19091905 -- | Response interpretation
19101906 response ->
19111907 -- | Header to lookup
@@ -1917,7 +1913,7 @@ responseHeader r h =
19171913
19181914-- | Get the response 'L.CookieJar'.
19191915responseCookieJar ::
1920− HttpResponse response =>
1916+ (HttpResponse response) =>
19211917 response ->
19221918 L.CookieJar
19231919responseCookieJar = L.responseCookieJar . toVanillaResponse
@@ -1971,6 +1967,16 @@ class HttpResponse response where
19711967 acceptHeader :: Proxy response -> Maybe ByteString
19721968 acceptHeader Proxy = Nothing
19731969
1970+-- | This instance has been added to make it easier to inspect 'L.Response'
1971+-- using Req's functions like 'responseStatusCode', 'responseStatusMessage',
1972+-- etc.
1973+--
1974+-- @since 3.12.0
1975+instance HttpResponse (L.Response ()) where
1976+ type HttpResponseBody (L.Response ()) = ()
1977+ toVanillaResponse = id
1978+ getHttpResponse = return . void
1979+
19741980----------------------------------------------------------------------------
19751981-- Other
19761982
@@ -2005,10 +2011,24 @@ data HttpException
20052011 | -- | A wrapper with Aeson-produced 'String' describing why decoding
20062012 -- failed
20072013 JsonHttpException String
2008− deriving (Show, Typeable, Generic)
2014+ deriving (Show, Generic)
20092015
20102016instance Exception HttpException
20112017
2018+-- | Return 'Just' if the given 'HttpException' is wrapping a http-client's
2019+-- 'L.StatusCodeException'. Otherwise, return 'Nothing'.
2020+--
2021+-- @since 3.12.0
2022+isStatusCodeException :: HttpException -> Maybe (L.Response ())
2023+isStatusCodeException
2024+ ( VanillaHttpException
2025+ ( L.HttpExceptionRequest
2026+ _
2027+ (L.StatusCodeException r _)
2028+ )
2029+ ) = Just r
2030+isStatusCodeException _ = Nothing
2031+
20122032-- | A simple type isomorphic to 'Bool' that we only have for better error
20132033-- messages. We use it as a kind and its data constructors as type-level
20142034-- tags.
@@ -2028,4 +2048,4 @@ data Scheme
20282048 Http
20292049 | -- | HTTPS
20302050 Https
2031− deriving (Eq, Ord, Show, Data, Typeable, Generic, TH.Lift)
2051+ deriving (Eq, Ord, Show, Data, Generic, TH.Lift)