@@ -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
@@ -203,72 +213,69 @@ module Network.HTTP.Req
203213 )
204214where
205215
206−import Blaze.ByteString.Builder qualified as BB
216+import qualified Blaze.ByteString.Builder as BB
207217import Control.Applicative
208218import Control.Arrow (first, second)
209219import Control.Exception hiding (Handler (..), TypeError)
210−import Control.Monad (guard, void, (>=>))
211220import Control.Monad.Base
212221import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
213222import Control.Monad.IO.Class
214223import Control.Monad.IO.Unlift
215−import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)
224+import Control.Monad.Reader
216225import Control.Monad.Trans.Accum (AccumT)
217226import Control.Monad.Trans.Cont (ContT)
218227import Control.Monad.Trans.Control
219228import Control.Monad.Trans.Except (ExceptT)
220229import Control.Monad.Trans.Identity (IdentityT)
221230import 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
231+import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS
232+import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
233+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
225234import 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
235+import qualified Control.Monad.Trans.State.Lazy as State.Lazy
236+import qualified Control.Monad.Trans.State.Strict as State.Strict
237+import qualified Control.Monad.Trans.Writer.CPS as Writer.CPS
238+import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
239+import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
231240import Control.Retry
232241import Data.Aeson (FromJSON (..), ToJSON (..))
233−import Data.Aeson qualified as A
242+import qualified Data.Aeson as A
234243import 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
244+import qualified Data.ByteString as B
245+import qualified Data.ByteString.Lazy as BL
246+import qualified Data.CaseInsensitive as CI
238247import Data.Data (Data)
239−import Data.Default.Class (def)
240248import Data.Function (on)
241249import Data.IORef
242250import Data.Kind (Constraint, Type)
243251import Data.List (foldl', nubBy)
244252import Data.List.NonEmpty (NonEmpty (..))
245−import Data.List.NonEmpty qualified as NE
253+import qualified Data.List.NonEmpty as NE
246254import Data.Maybe (fromMaybe)
247255import Data.Proxy
248256import Data.Semigroup (Endo (..))
249−import Data.Set qualified as S
250257import Data.Text (Text)
251−import Data.Text qualified as T
252−import Data.Text.Encoding qualified as T
258+import qualified Data.Text as T
259+import qualified Data.Text.Encoding as T
253260import Data.Typeable (Typeable, cast)
254261import GHC.Generics
255262import 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
263+import qualified Language.Haskell.TH as TH
264+import qualified Language.Haskell.TH.Quote as TH
265+import qualified Language.Haskell.TH.Syntax as TH
266+import qualified Network.Connection as NC
267+import qualified Network.HTTP.Client as L
268+import qualified Network.HTTP.Client.Internal as LI
269+import qualified Network.HTTP.Client.MultipartFormData as LM
270+import qualified Network.HTTP.Client.TLS as L
271+import qualified Network.HTTP.Types as Y
265272import System.IO.Unsafe (unsafePerformIO)
266273import 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
274+import qualified Text.URI as URI
275+import qualified Text.URI.QQ as QQ
276+import qualified Web.Authenticate.OAuth as OAuth
270277import Web.FormUrlEncoded (FromForm (..), ToForm (..))
271−import Web.FormUrlEncoded qualified as Form
278+import qualified Web.FormUrlEncoded as Form
272279import Web.HttpApiData (ToHttpApiData (..))
273280
274281----------------------------------------------------------------------------
@@ -489,7 +496,7 @@ reqCb method url body responseProxy options adjustRequest =
489496--
490497-- @since 3.7.0
491498reqHandler ::
492− (MonadHttp m) =>
499+ MonadHttp m =>
493500 -- | How to get final result from a 'L.Response'
494501 (L.Response L.BodyReader -> IO b) ->
495502 -- | 'L.Request' to perform
@@ -585,10 +592,10 @@ req' method url body options m = do
585592 withReqManager (m request)
586593
587594-- | 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
595+-- of the library uses. This allows to reuse connections that the
589596-- 'L.Manager' controls.
590−withReqManager :: (MonadIO m) => (L.Manager -> m a) -> m a
591−withReqManager m = m globalManager
597+withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
598+withReqManager m = liftIO (readIORef globalManager) >>= m
592599
593600-- | The global 'L.Manager' that 'req' uses. Here we just go with the
594601-- default settings, so users don't need to deal with this manager stuff at
@@ -601,16 +608,16 @@ withReqManager m = m globalManager
601608-- manager. From that moment on the 'IORef' will be just reused—exactly the
602609-- behavior we want here in order to maximize connection sharing. GHC could
603610-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
604−globalManager :: L.Manager
611+globalManager :: IORef L.Manager
605612globalManager = unsafePerformIO $ do
606613 context <- NC.initConnectionContext
607614 let settings =
608615 L.mkManagerSettingsContext
609616 (Just context)
610− def
617+ (NC.TLSSettingsSimple False False False)
611618 Nothing
612619 manager <- L.newManager settings
613− return manager
620+ newIORef manager
614621{-# NOINLINE globalManager #-}
615622
616623----------------------------------------------------------------------------
@@ -630,7 +637,7 @@ globalManager = unsafePerformIO $ do
630637-- | A type class for monads that support performing HTTP requests.
631638-- Typically, you only need to define the 'handleHttpException' method
632639-- unless you want to tweak 'HttpConfig'.
633−class (MonadIO m) => MonadHttp m where
640+class MonadIO m => MonadHttp m where
634641 -- | This method describes how to deal with 'HttpException' that was
635642 -- caught by the library. One option is to re-throw it if you are OK with
636643 -- exceptions, but if you prefer working with something like
@@ -714,8 +721,9 @@ data HttpConfig = HttpConfig
714721 -- | Max length of preview fragment of response body.
715722 --
716723 -- @since 3.6.0
717− httpConfigBodyPreviewLength :: forall a. (Num a) => a
724+ httpConfigBodyPreviewLength :: forall a. Num a => a
718725 }
726+ deriving (Typeable)
719727
720728-- | The default value of 'HttpConfig'.
721729--
@@ -803,27 +811,27 @@ instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where
803811 getHttpConfig = lift getHttpConfig
804812
805813-- | @since 3.10.0
806−instance (MonadHttp m) => MonadHttp (ContT r m) where
814+instance MonadHttp m => MonadHttp (ContT r m) where
807815 handleHttpException = lift . handleHttpException
808816 getHttpConfig = lift getHttpConfig
809817
810818-- | @since 3.10.0
811−instance (MonadHttp m) => MonadHttp (ExceptT e m) where
819+instance MonadHttp m => MonadHttp (ExceptT e m) where
812820 handleHttpException = lift . handleHttpException
813821 getHttpConfig = lift getHttpConfig
814822
815823-- | @since 3.10.0
816−instance (MonadHttp m) => MonadHttp (IdentityT m) where
824+instance MonadHttp m => MonadHttp (IdentityT m) where
817825 handleHttpException = lift . handleHttpException
818826 getHttpConfig = lift getHttpConfig
819827
820828-- | @since 3.10.0
821−instance (MonadHttp m) => MonadHttp (MaybeT m) where
829+instance MonadHttp m => MonadHttp (MaybeT m) where
822830 handleHttpException = lift . handleHttpException
823831 getHttpConfig = lift getHttpConfig
824832
825833-- | @since 3.10.0
826−instance (MonadHttp m) => MonadHttp (ReaderT r m) where
834+instance MonadHttp m => MonadHttp (ReaderT r m) where
827835 handleHttpException = lift . handleHttpException
828836 getHttpConfig = lift getHttpConfig
829837
@@ -843,17 +851,17 @@ instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Strict.RWST r w s m) where
843851 getHttpConfig = lift getHttpConfig
844852
845853-- | @since 3.10.0
846−instance (MonadHttp m) => MonadHttp (SelectT r m) where
854+instance MonadHttp m => MonadHttp (SelectT r m) where
847855 handleHttpException = lift . handleHttpException
848856 getHttpConfig = lift getHttpConfig
849857
850858-- | @since 3.10.0
851−instance (MonadHttp m) => MonadHttp (State.Lazy.StateT s m) where
859+instance MonadHttp m => MonadHttp (State.Lazy.StateT s m) where
852860 handleHttpException = lift . handleHttpException
853861 getHttpConfig = lift getHttpConfig
854862
855863-- | @since 3.10.0
856−instance (MonadHttp m) => MonadHttp (State.Strict.StateT s m) where
864+instance MonadHttp m => MonadHttp (State.Strict.StateT s m) where
857865 handleHttpException = lift . handleHttpException
858866 getHttpConfig = lift getHttpConfig
859867
@@ -877,7 +885,7 @@ instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Strict.WriterT w m) where
877885--
878886-- @since 0.4.0
879887runReq ::
880− (MonadIO m) =>
888+ MonadIO m =>
881889 -- | 'HttpConfig' to use
882890 HttpConfig ->
883891 -- | Computation to run
@@ -982,7 +990,7 @@ class HttpMethod a where
982990 -- | Return name of the method as a 'ByteString'.
983991 httpMethodName :: Proxy a -> ByteString
984992
985−instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
993+instance HttpMethod method => RequestComponent (Tagged "method" method) where
986994 getRequestMod _ = Endo $ \x ->
987995 x {L.method = httpMethodName (Proxy :: Proxy method)}
988996
@@ -1024,20 +1032,25 @@ instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
10241032-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
10251033data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
10261034 -- NOTE The second value is the path segments in reversed order.
1027− deriving (Eq, Ord, Show, Data, Generic)
1035+ deriving (Eq, Ord, Show, Data, Typeable, Generic)
10281036
10291037type role Url nominal
10301038
10311039-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however
10321040-- the derived lift forgets the type of the scheme.
1033−instance (Typeable scheme) => TH.Lift (Url scheme) where
1041+instance Typeable scheme => TH.Lift (Url scheme) where
10341042 lift url =
10351043 TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of
10361044 Url Http _ -> [t|Url 'Http|]
10371045 Url Https _ -> [t|Url 'Https|]
10381046 where
10391047 liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
1048+
1049+#if MIN_VERSION_template_haskell(2,17,0)
10401050 liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
1051+#elif MIN_VERSION_template_haskell(2,16,0)
1052+ liftTyped = TH.unsafeTExpCoerce . TH.lift
1053+#endif
10411054
10421055-- | Given host name, produce a 'Url' which has “http” as its scheme and
10431056-- empty path. This also sets port to @80@.
@@ -1053,7 +1066,7 @@ https = Url Https . pure
10531066-- path segment can be of any type that is an instance of 'ToHttpApiData'.
10541067infixl 5 /~
10551068
1056−(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme
1069+(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
10571070Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
10581071
10591072-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases
@@ -1241,7 +1254,7 @@ instance HttpBody NoReqBody where
12411254-- charset=utf-8\"@ value.
12421255newtype ReqBodyJson a = ReqBodyJson a
12431256
1244−instance (ToJSON a) => HttpBody (ReqBodyJson a) where
1257+instance ToJSON a => HttpBody (ReqBodyJson a) where
12451258 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)
12461259 getRequestContentType _ = pure "application/json; charset=utf-8"
12471260
@@ -1340,7 +1353,7 @@ instance HttpBody ReqBodyMultipart where
13401353-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
13411354--
13421355-- @since 0.2.0
1343−reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart
1356+reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
13441357reqBodyMultipart parts = liftIO $ do
13451358 boundary <- LM.webkitBoundary
13461359 body <- LM.renderParts boundary parts
@@ -1380,7 +1393,7 @@ type family
13801393 TypeError
13811394 ('Text "This HTTP method does not allow attaching a request body.")
13821395
1383−instance (HttpBody body) => RequestComponent (Tagged "body" body) where
1396+instance HttpBody body => RequestComponent (Tagged "body" body) where
13841397 getRequestMod (Tagged body) = Endo $ \x ->
13851398 x
13861399 { L.requestBody = getRequestBody body,
@@ -1450,7 +1463,7 @@ instance RequestComponent (Option scheme) where
14501463
14511464-- | Finalize given 'L.Request' by applying a finalizer from the given
14521465-- 'Option' (if it has any).
1453−finalizeRequest :: (MonadIO m) => Option scheme -> L.Request -> m L.Request
1466+finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
14541467finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
14551468
14561469----------------------------------------------------------------------------
@@ -1483,7 +1496,7 @@ name =: value = queryParam name (pure value)
14831496-- This operator is defined in terms of 'queryParam':
14841497--
14851498-- > queryFlag name = queryParam name (Nothing :: Maybe ())
1486−queryFlag :: (QueryParam param) => Text -> param
1499+queryFlag :: QueryParam param => Text -> param
14871500queryFlag name = queryParam name (Nothing :: Maybe ())
14881501
14891502-- | Construct query parameters from a 'ToForm' instance. This function
@@ -1513,7 +1526,7 @@ class QueryParam param where
15131526 -- 'Nothing', it won't be included at all (i.e. you create a flag this
15141527 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
15151528 -- method, because they are easier to read.
1516− queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param
1529+ queryParam :: ToHttpApiData a => Text -> Maybe a -> param
15171530
15181531 -- | Get the query parameter names and values set by 'queryParam'.
15191532 --
@@ -1547,14 +1560,6 @@ attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
15471560attachHeader name value x =
15481561 x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
15491562
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−
15581563----------------------------------------------------------------------------
15591564-- Request—Optional parameters—Cookies
15601565
@@ -1762,7 +1767,7 @@ ignoreResponse = Proxy
17621767newtype JsonResponse a = JsonResponse (L.Response a)
17631768 deriving (Show)
17641769
1765−instance (FromJSON a) => HttpResponse (JsonResponse a) where
1770+instance FromJSON a => HttpResponse (JsonResponse a) where
17661771 type HttpResponseBody (JsonResponse a) = a
17671772 toVanillaResponse (JsonResponse r) = r
17681773 getHttpResponse r = do
@@ -1878,14 +1883,14 @@ brReadN br n = go 0 id id
18781883
18791884-- | Get the response body.
18801885responseBody ::
1881− (HttpResponse response) =>
1886+ HttpResponse response =>
18821887 response ->
18831888 HttpResponseBody response
18841889responseBody = L.responseBody . toVanillaResponse
18851890
18861891-- | Get the response status code.
18871892responseStatusCode ::
1888− (HttpResponse response) =>
1893+ HttpResponse response =>
18891894 response ->
18901895 Int
18911896responseStatusCode =
@@ -1893,7 +1898,7 @@ responseStatusCode =
18931898
18941899-- | Get the response status message.
18951900responseStatusMessage ::
1896− (HttpResponse response) =>
1901+ HttpResponse response =>
18971902 response ->
18981903 ByteString
18991904responseStatusMessage =
@@ -1901,7 +1906,7 @@ responseStatusMessage =
19011906
19021907-- | Lookup a particular header from a response.
19031908responseHeader ::
1904− (HttpResponse response) =>
1909+ HttpResponse response =>
19051910 -- | Response interpretation
19061911 response ->
19071912 -- | Header to lookup
@@ -1913,7 +1918,7 @@ responseHeader r h =
19131918
19141919-- | Get the response 'L.CookieJar'.
19151920responseCookieJar ::
1916− (HttpResponse response) =>
1921+ HttpResponse response =>
19171922 response ->
19181923 L.CookieJar
19191924responseCookieJar = L.responseCookieJar . toVanillaResponse
@@ -2011,7 +2016,7 @@ data HttpException
20112016 | -- | A wrapper with Aeson-produced 'String' describing why decoding
20122017 -- failed
20132018 JsonHttpException String
2014− deriving (Show, Generic)
2019+ deriving (Show, Typeable, Generic)
20152020
20162021instance Exception HttpException
20172022
@@ -2048,4 +2053,4 @@ data Scheme
20482053 Http
20492054 | -- | HTTPS
20502055 Https
2051− deriving (Eq, Ord, Show, Data, Generic, TH.Lift)
2056+ deriving (Eq, Ord, Show, Data, Typeable, Generic, TH.Lift)