@@ -1,9 +1,20 @@
1+{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE CPP #-}
13{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE DeriveDataTypeable #-}
5+{-# LANGUAGE DeriveGeneric #-}
6+{-# LANGUAGE DeriveLift #-}
7+{-# LANGUAGE FlexibleInstances #-}
8+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
29{-# LANGUAGE LambdaCase #-}
10+{-# LANGUAGE MultiParamTypeClasses #-}
311{-# LANGUAGE OverloadedStrings #-}
412{-# LANGUAGE QuasiQuotes #-}
13+{-# LANGUAGE RankNTypes #-}
514{-# LANGUAGE RecordWildCards #-}
615{-# LANGUAGE RoleAnnotations #-}
16+{-# LANGUAGE ScopedTypeVariables #-}
17+{-# LANGUAGE StandaloneDeriving #-}
718{-# LANGUAGE TemplateHaskellQuotes #-}
819{-# LANGUAGE TypeFamilies #-}
920{-# LANGUAGE UndecidableInstances #-}
@@ -150,7 +161,6 @@ module Network.HTTP.Req
150161 -- *** Headers
151162 header,
152163 attachHeader,
153− headerRedacted,
154164
155165 -- *** Cookies
156166 -- $cookies
@@ -197,78 +207,74 @@ module Network.HTTP.Req
197207
198208 -- * Other
199209 HttpException (..),
200− isStatusCodeException,
201210 CanHaveBody (..),
202211 Scheme (..),
203212 )
204213where
205214
206−import Blaze.ByteString.Builder qualified as BB
215+import qualified Blaze.ByteString.Builder as BB
207216import Control.Applicative
208217import Control.Arrow (first, second)
209218import Control.Exception hiding (Handler (..), TypeError)
210−import Control.Monad (guard, void, (>=>))
211219import Control.Monad.Base
212220import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
213221import Control.Monad.IO.Class
214222import Control.Monad.IO.Unlift
215−import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)
223+import Control.Monad.Reader
216224import Control.Monad.Trans.Accum (AccumT)
217225import Control.Monad.Trans.Cont (ContT)
218226import Control.Monad.Trans.Control
219227import Control.Monad.Trans.Except (ExceptT)
220228import Control.Monad.Trans.Identity (IdentityT)
221229import Control.Monad.Trans.Maybe (MaybeT)
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
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
225233import Control.Monad.Trans.Select (SelectT)
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
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
231239import Control.Retry
232240import Data.Aeson (FromJSON (..), ToJSON (..))
233−import Data.Aeson qualified as A
241+import qualified Data.Aeson as A
234242import Data.ByteString (ByteString)
235−import Data.ByteString qualified as B
236−import Data.ByteString.Lazy qualified as BL
237−import Data.CaseInsensitive qualified as CI
243+import qualified Data.ByteString as B
244+import qualified Data.ByteString.Lazy as BL
245+import qualified Data.CaseInsensitive as CI
238246import Data.Data (Data)
239−import Data.Default.Class (def)
240247import Data.Function (on)
241248import Data.IORef
242249import Data.Kind (Constraint, Type)
243250import Data.List (foldl', nubBy)
244251import Data.List.NonEmpty (NonEmpty (..))
245−import Data.List.NonEmpty qualified as NE
252+import qualified Data.List.NonEmpty as NE
246253import Data.Maybe (fromMaybe)
247254import Data.Proxy
248255import Data.Semigroup (Endo (..))
249−import Data.Set qualified as S
250256import Data.Text (Text)
251−import Data.Text qualified as T
252−import Data.Text.Encoding qualified as T
257+import qualified Data.Text as T
258+import qualified Data.Text.Encoding as T
253259import Data.Typeable (Typeable, cast)
254260import GHC.Generics
255261import GHC.TypeLits
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
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
265271import System.IO.Unsafe (unsafePerformIO)
266272import Text.URI (URI)
267−import Text.URI qualified as URI
268−import Text.URI.QQ qualified as QQ
269−import Web.Authenticate.OAuth qualified as OAuth
273+import qualified Text.URI as URI
274+import qualified Text.URI.QQ as QQ
275+import qualified Web.Authenticate.OAuth as OAuth
270276import Web.FormUrlEncoded (FromForm (..), ToForm (..))
271−import Web.FormUrlEncoded qualified as Form
277+import qualified Web.FormUrlEncoded as Form
272278import Web.HttpApiData (ToHttpApiData (..))
273279
274280----------------------------------------------------------------------------
@@ -489,7 +495,7 @@ reqCb method url body responseProxy options adjustRequest =
489495--
490496-- @since 3.7.0
491497reqHandler ::
492− (MonadHttp m) =>
498+ MonadHttp m =>
493499 -- | How to get final result from a 'L.Response'
494500 (L.Response L.BodyReader -> IO b) ->
495501 -- | 'L.Request' to perform
@@ -585,10 +591,10 @@ req' method url body options m = do
585591 withReqManager (m request)
586592
587593-- | Perform an action using the global implicit 'L.Manager' that the rest
588−-- of the library uses. This allows us to reuse connections that the
594+-- of the library uses. This allows to reuse connections that the
589595-- 'L.Manager' controls.
590−withReqManager :: (MonadIO m) => (L.Manager -> m a) -> m a
591−withReqManager m = m globalManager
596+withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
597+withReqManager m = liftIO (readIORef globalManager) >>= m
592598
593599-- | The global 'L.Manager' that 'req' uses. Here we just go with the
594600-- default settings, so users don't need to deal with this manager stuff at
@@ -601,16 +607,16 @@ withReqManager m = m globalManager
601607-- manager. From that moment on the 'IORef' will be just reused—exactly the
602608-- behavior we want here in order to maximize connection sharing. GHC could
603609-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
604−globalManager :: L.Manager
610+globalManager :: IORef L.Manager
605611globalManager = unsafePerformIO $ do
606612 context <- NC.initConnectionContext
607613 let settings =
608614 L.mkManagerSettingsContext
609615 (Just context)
610− def
616+ (NC.TLSSettingsSimple False False False)
611617 Nothing
612618 manager <- L.newManager settings
613− return manager
619+ newIORef manager
614620{-# NOINLINE globalManager #-}
615621
616622----------------------------------------------------------------------------
@@ -630,7 +636,7 @@ globalManager = unsafePerformIO $ do
630636-- | A type class for monads that support performing HTTP requests.
631637-- Typically, you only need to define the 'handleHttpException' method
632638-- unless you want to tweak 'HttpConfig'.
633−class (MonadIO m) => MonadHttp m where
639+class MonadIO m => MonadHttp m where
634640 -- | This method describes how to deal with 'HttpException' that was
635641 -- caught by the library. One option is to re-throw it if you are OK with
636642 -- exceptions, but if you prefer working with something like
@@ -714,8 +720,9 @@ data HttpConfig = HttpConfig
714720 -- | Max length of preview fragment of response body.
715721 --
716722 -- @since 3.6.0
717− httpConfigBodyPreviewLength :: forall a. (Num a) => a
723+ httpConfigBodyPreviewLength :: forall a. Num a => a
718724 }
725+ deriving (Typeable)
719726
720727-- | The default value of 'HttpConfig'.
721728--
@@ -803,27 +810,27 @@ instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where
803810 getHttpConfig = lift getHttpConfig
804811
805812-- | @since 3.10.0
806−instance (MonadHttp m) => MonadHttp (ContT r m) where
813+instance MonadHttp m => MonadHttp (ContT r m) where
807814 handleHttpException = lift . handleHttpException
808815 getHttpConfig = lift getHttpConfig
809816
810817-- | @since 3.10.0
811−instance (MonadHttp m) => MonadHttp (ExceptT e m) where
818+instance MonadHttp m => MonadHttp (ExceptT e m) where
812819 handleHttpException = lift . handleHttpException
813820 getHttpConfig = lift getHttpConfig
814821
815822-- | @since 3.10.0
816−instance (MonadHttp m) => MonadHttp (IdentityT m) where
823+instance MonadHttp m => MonadHttp (IdentityT m) where
817824 handleHttpException = lift . handleHttpException
818825 getHttpConfig = lift getHttpConfig
819826
820827-- | @since 3.10.0
821−instance (MonadHttp m) => MonadHttp (MaybeT m) where
828+instance MonadHttp m => MonadHttp (MaybeT m) where
822829 handleHttpException = lift . handleHttpException
823830 getHttpConfig = lift getHttpConfig
824831
825832-- | @since 3.10.0
826−instance (MonadHttp m) => MonadHttp (ReaderT r m) where
833+instance MonadHttp m => MonadHttp (ReaderT r m) where
827834 handleHttpException = lift . handleHttpException
828835 getHttpConfig = lift getHttpConfig
829836
@@ -843,17 +850,17 @@ instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Strict.RWST r w s m) where
843850 getHttpConfig = lift getHttpConfig
844851
845852-- | @since 3.10.0
846−instance (MonadHttp m) => MonadHttp (SelectT r m) where
853+instance MonadHttp m => MonadHttp (SelectT r m) where
847854 handleHttpException = lift . handleHttpException
848855 getHttpConfig = lift getHttpConfig
849856
850857-- | @since 3.10.0
851−instance (MonadHttp m) => MonadHttp (State.Lazy.StateT s m) where
858+instance MonadHttp m => MonadHttp (State.Lazy.StateT s m) where
852859 handleHttpException = lift . handleHttpException
853860 getHttpConfig = lift getHttpConfig
854861
855862-- | @since 3.10.0
856−instance (MonadHttp m) => MonadHttp (State.Strict.StateT s m) where
863+instance MonadHttp m => MonadHttp (State.Strict.StateT s m) where
857864 handleHttpException = lift . handleHttpException
858865 getHttpConfig = lift getHttpConfig
859866
@@ -877,7 +884,7 @@ instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Strict.WriterT w m) where
877884--
878885-- @since 0.4.0
879886runReq ::
880− (MonadIO m) =>
887+ MonadIO m =>
881888 -- | 'HttpConfig' to use
882889 HttpConfig ->
883890 -- | Computation to run
@@ -982,7 +989,7 @@ class HttpMethod a where
982989 -- | Return name of the method as a 'ByteString'.
983990 httpMethodName :: Proxy a -> ByteString
984991
985−instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
992+instance HttpMethod method => RequestComponent (Tagged "method" method) where
986993 getRequestMod _ = Endo $ \x ->
987994 x {L.method = httpMethodName (Proxy :: Proxy method)}
988995
@@ -1024,20 +1031,25 @@ instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
10241031-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
10251032data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
10261033 -- NOTE The second value is the path segments in reversed order.
1027− deriving (Eq, Ord, Show, Data, Generic)
1034+ deriving (Eq, Ord, Show, Data, Typeable, Generic)
10281035
10291036type role Url nominal
10301037
10311038-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however
10321039-- the derived lift forgets the type of the scheme.
1033−instance (Typeable scheme) => TH.Lift (Url scheme) where
1040+instance Typeable scheme => TH.Lift (Url scheme) where
10341041 lift url =
10351042 TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of
10361043 Url Http _ -> [t|Url 'Http|]
10371044 Url Https _ -> [t|Url 'Https|]
10381045 where
10391046 liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
1047+
1048+#if MIN_VERSION_template_haskell(2,17,0)
10401049 liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
1050+#elif MIN_VERSION_template_haskell(2,16,0)
1051+ liftTyped = TH.unsafeTExpCoerce . TH.lift
1052+#endif
10411053
10421054-- | Given host name, produce a 'Url' which has “http” as its scheme and
10431055-- empty path. This also sets port to @80@.
@@ -1053,7 +1065,7 @@ https = Url Https . pure
10531065-- path segment can be of any type that is an instance of 'ToHttpApiData'.
10541066infixl 5 /~
10551067
1056−(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme
1068+(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
10571069Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
10581070
10591071-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases
@@ -1241,7 +1253,7 @@ instance HttpBody NoReqBody where
12411253-- charset=utf-8\"@ value.
12421254newtype ReqBodyJson a = ReqBodyJson a
12431255
1244−instance (ToJSON a) => HttpBody (ReqBodyJson a) where
1256+instance ToJSON a => HttpBody (ReqBodyJson a) where
12451257 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)
12461258 getRequestContentType _ = pure "application/json; charset=utf-8"
12471259
@@ -1340,7 +1352,7 @@ instance HttpBody ReqBodyMultipart where
13401352-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
13411353--
13421354-- @since 0.2.0
1343−reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart
1355+reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
13441356reqBodyMultipart parts = liftIO $ do
13451357 boundary <- LM.webkitBoundary
13461358 body <- LM.renderParts boundary parts
@@ -1380,7 +1392,7 @@ type family
13801392 TypeError
13811393 ('Text "This HTTP method does not allow attaching a request body.")
13821394
1383−instance (HttpBody body) => RequestComponent (Tagged "body" body) where
1395+instance HttpBody body => RequestComponent (Tagged "body" body) where
13841396 getRequestMod (Tagged body) = Endo $ \x ->
13851397 x
13861398 { L.requestBody = getRequestBody body,
@@ -1450,7 +1462,7 @@ instance RequestComponent (Option scheme) where
14501462
14511463-- | Finalize given 'L.Request' by applying a finalizer from the given
14521464-- 'Option' (if it has any).
1453−finalizeRequest :: (MonadIO m) => Option scheme -> L.Request -> m L.Request
1465+finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
14541466finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
14551467
14561468----------------------------------------------------------------------------
@@ -1483,7 +1495,7 @@ name =: value = queryParam name (pure value)
14831495-- This operator is defined in terms of 'queryParam':
14841496--
14851497-- > queryFlag name = queryParam name (Nothing :: Maybe ())
1486−queryFlag :: (QueryParam param) => Text -> param
1498+queryFlag :: QueryParam param => Text -> param
14871499queryFlag name = queryParam name (Nothing :: Maybe ())
14881500
14891501-- | Construct query parameters from a 'ToForm' instance. This function
@@ -1513,7 +1525,7 @@ class QueryParam param where
15131525 -- 'Nothing', it won't be included at all (i.e. you create a flag this
15141526 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
15151527 -- method, because they are easier to read.
1516− queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param
1528+ queryParam :: ToHttpApiData a => Text -> Maybe a -> param
15171529
15181530 -- | Get the query parameter names and values set by 'queryParam'.
15191531 --
@@ -1547,14 +1559,6 @@ attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
15471559attachHeader name value x =
15481560 x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
15491561
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−
15581562----------------------------------------------------------------------------
15591563-- Request—Optional parameters—Cookies
15601564
@@ -1762,7 +1766,7 @@ ignoreResponse = Proxy
17621766newtype JsonResponse a = JsonResponse (L.Response a)
17631767 deriving (Show)
17641768
1765−instance (FromJSON a) => HttpResponse (JsonResponse a) where
1769+instance FromJSON a => HttpResponse (JsonResponse a) where
17661770 type HttpResponseBody (JsonResponse a) = a
17671771 toVanillaResponse (JsonResponse r) = r
17681772 getHttpResponse r = do
@@ -1878,14 +1882,14 @@ brReadN br n = go 0 id id
18781882
18791883-- | Get the response body.
18801884responseBody ::
1881− (HttpResponse response) =>
1885+ HttpResponse response =>
18821886 response ->
18831887 HttpResponseBody response
18841888responseBody = L.responseBody . toVanillaResponse
18851889
18861890-- | Get the response status code.
18871891responseStatusCode ::
1888− (HttpResponse response) =>
1892+ HttpResponse response =>
18891893 response ->
18901894 Int
18911895responseStatusCode =
@@ -1893,7 +1897,7 @@ responseStatusCode =
18931897
18941898-- | Get the response status message.
18951899responseStatusMessage ::
1896− (HttpResponse response) =>
1900+ HttpResponse response =>
18971901 response ->
18981902 ByteString
18991903responseStatusMessage =
@@ -1901,7 +1905,7 @@ responseStatusMessage =
19011905
19021906-- | Lookup a particular header from a response.
19031907responseHeader ::
1904− (HttpResponse response) =>
1908+ HttpResponse response =>
19051909 -- | Response interpretation
19061910 response ->
19071911 -- | Header to lookup
@@ -1913,7 +1917,7 @@ responseHeader r h =
19131917
19141918-- | Get the response 'L.CookieJar'.
19151919responseCookieJar ::
1916− (HttpResponse response) =>
1920+ HttpResponse response =>
19171921 response ->
19181922 L.CookieJar
19191923responseCookieJar = L.responseCookieJar . toVanillaResponse
@@ -1967,16 +1971,6 @@ class HttpResponse response where
19671971 acceptHeader :: Proxy response -> Maybe ByteString
19681972 acceptHeader Proxy = Nothing
19691973
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−
19801974----------------------------------------------------------------------------
19811975-- Other
19821976
@@ -2011,24 +2005,10 @@ data HttpException
20112005 | -- | A wrapper with Aeson-produced 'String' describing why decoding
20122006 -- failed
20132007 JsonHttpException String
2014− deriving (Show, Generic)
2008+ deriving (Show, Typeable, Generic)
20152009
20162010instance Exception HttpException
20172011
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−
20322012-- | A simple type isomorphic to 'Bool' that we only have for better error
20332013-- messages. We use it as a kind and its data constructors as type-level
20342014-- tags.
@@ -2048,4 +2028,4 @@ data Scheme
20482028 Http
20492029 | -- | HTTPS
20502030 Https
2051− deriving (Eq, Ord, Show, Data, Generic, TH.Lift)
2031+ deriving (Eq, Ord, Show, Data, Typeable, Generic, TH.Lift)