@@ -1,3 +1,20 @@
1+{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+{-# LANGUAGE KindSignatures #-}
8+{-# LANGUAGE LambdaCase #-}
9+{-# LANGUAGE MultiParamTypeClasses #-}
10+{-# LANGUAGE OverloadedStrings #-}
11+{-# LANGUAGE QuasiQuotes #-}
12+{-# LANGUAGE RankNTypes #-}
13+{-# LANGUAGE RecordWildCards #-}
14+{-# LANGUAGE ScopedTypeVariables #-}
15+{-# LANGUAGE TypeFamilies #-}
16+{-# LANGUAGE UndecidableInstances #-}
17+
118-- |
219-- Module : Network.HTTP.Req
320-- Copyright : © 2016–present Mark Karpov
@@ -87,128 +104,128 @@
87104-- the whole Haskell ecosystem uses, there is no risk in using @req@. The
88105-- machinery for performing requests is the same as with @http-conduit@ and
89106-- @wreq@. The only difference is the API.
90−
91−{-# LANGUAGE BangPatterns #-}
92−{-# LANGUAGE DataKinds #-}
93−{-# LANGUAGE DeriveDataTypeable #-}
94−{-# LANGUAGE DeriveGeneric #-}
95−{-# LANGUAGE FlexibleInstances #-}
96−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
97−{-# LANGUAGE KindSignatures #-}
98−{-# LANGUAGE LambdaCase #-}
99−{-# LANGUAGE MultiParamTypeClasses #-}
100−{-# LANGUAGE OverloadedStrings #-}
101−{-# LANGUAGE QuasiQuotes #-}
102−{-# LANGUAGE RankNTypes #-}
103−{-# LANGUAGE RecordWildCards #-}
104−{-# LANGUAGE ScopedTypeVariables #-}
105−{-# LANGUAGE TypeFamilies #-}
106−{-# LANGUAGE UndecidableInstances #-}
107−
108107module Network.HTTP.Req
109108 ( -- * Making a request
110109 -- $making-a-request
111− req
112− , reqBr
113− , req'
114− , withReqManager
110+ req,
111+ reqBr,
112+ req',
113+ withReqManager,
114+
115115 -- * Embedding requests in your monad
116116 -- $embedding-requests
117− , MonadHttp (..)
118− , HttpConfig (..)
119− , defaultHttpConfig
120− , Req
121− , runReq
117+ MonadHttp (..),
118+ HttpConfig (..),
119+ defaultHttpConfig,
120+ Req,
121+ runReq,
122+
122123 -- * Request
124+
123125 -- ** Method
124126 -- $method
125− , GET (..)
126− , POST (..)
127− , HEAD (..)
128− , PUT (..)
129− , DELETE (..)
130− , TRACE (..)
131− , CONNECT (..)
132− , OPTIONS (..)
133− , PATCH (..)
134− , HttpMethod (..)
127+ GET (..),
128+ POST (..),
129+ HEAD (..),
130+ PUT (..),
131+ DELETE (..),
132+ TRACE (..),
133+ CONNECT (..),
134+ OPTIONS (..),
135+ PATCH (..),
136+ HttpMethod (..),
137+
135138 -- ** URL
136139 -- $url
137− , Url
138− , http
139− , https
140− , (/~)
141− , (/:)
142− , useHttpURI
143− , useHttpsURI
144− , useURI
140+ Url,
141+ http,
142+ https,
143+ (/~),
144+ (/:),
145+ useHttpURI,
146+ useHttpsURI,
147+ useURI,
148+
145149 -- ** Body
146150 -- $body
147− , NoReqBody (..)
148− , ReqBodyJson (..)
149− , ReqBodyFile (..)
150− , ReqBodyBs (..)
151− , ReqBodyLbs (..)
152− , ReqBodyUrlEnc (..)
153− , FormUrlEncodedParam
154− , ReqBodyMultipart
155− , reqBodyMultipart
156− , HttpBody (..)
157− , ProvidesBody
158− , HttpBodyAllowed
151+ NoReqBody (..),
152+ ReqBodyJson (..),
153+ ReqBodyFile (..),
154+ ReqBodyBs (..),
155+ ReqBodyLbs (..),
156+ ReqBodyUrlEnc (..),
157+ FormUrlEncodedParam,
158+ ReqBodyMultipart,
159+ reqBodyMultipart,
160+ HttpBody (..),
161+ ProvidesBody,
162+ HttpBodyAllowed,
163+
159164 -- ** Optional parameters
160165 -- $optional-parameters
161− , Option
166+ Option,
167+
162168 -- *** Query parameters
163169 -- $query-parameters
164− , (=:)
165− , queryFlag
166− , QueryParam (..)
170+ (=:),
171+ queryFlag,
172+ QueryParam (..),
173+
167174 -- *** Headers
168− , header
169− , attachHeader
175+ header,
176+ attachHeader,
177+
170178 -- *** Cookies
171179 -- $cookies
172− , cookieJar
180+ cookieJar,
181+
173182 -- *** Authentication
174183 -- $authentication
175− , basicAuth
176− , basicAuthUnsafe
177− , basicProxyAuth
178− , oAuth1
179− , oAuth2Bearer
180− , oAuth2Token
181− , customAuth
184+ basicAuth,
185+ basicAuthUnsafe,
186+ basicProxyAuth,
187+ oAuth1,
188+ oAuth2Bearer,
189+ oAuth2Token,
190+ customAuth,
191+
182192 -- *** Other
183− , port
184− , decompress
185− , responseTimeout
186− , httpVersion
193+ port,
194+ decompress,
195+ responseTimeout,
196+ httpVersion,
197+
187198 -- * Response
199+
188200 -- ** Response interpretations
189− , IgnoreResponse
190− , ignoreResponse
191− , JsonResponse
192− , jsonResponse
193− , BsResponse
194− , bsResponse
195− , LbsResponse
196− , lbsResponse
201+ IgnoreResponse,
202+ ignoreResponse,
203+ JsonResponse,
204+ jsonResponse,
205+ BsResponse,
206+ bsResponse,
207+ LbsResponse,
208+ lbsResponse,
209+
197210 -- ** Inspecting a response
198− , responseBody
199− , responseStatusCode
200− , responseStatusMessage
201− , responseHeader
202− , responseCookieJar
211+ responseBody,
212+ responseStatusCode,
213+ responseStatusMessage,
214+ responseHeader,
215+ responseCookieJar,
216+
203217 -- ** Defining your own interpretation
204218 -- $new-response-interpretation
205− , HttpResponse (..)
219+ HttpResponse (..),
220+
206221 -- * Other
207− , HttpException (..)
208− , CanHaveBody (..)
209− , Scheme (..) )
222+ HttpException (..),
223+ CanHaveBody (..),
224+ Scheme (..),
225+ )
210226where
211227
228+import qualified Blaze.ByteString.Builder as BB
212229import Control.Applicative
213230import Control.Arrow (first, second)
214231import Control.Exception hiding (TypeError)
@@ -217,40 +234,39 @@ import Control.Monad.IO.Class
217234import Control.Monad.Reader
218235import Control.Monad.Trans.Control
219236import Control.Retry
220−import Data.Aeson (ToJSON (..), FromJSON (..))
237+import Data.Aeson (FromJSON (..), ToJSON (..))
238+import qualified Data.Aeson as A
221239import Data.ByteString (ByteString)
240+import qualified Data.ByteString as B
241+import qualified Data.ByteString.Lazy as BL
242+import qualified Data.CaseInsensitive as CI
222243import Data.Data (Data)
223244import Data.Function (on)
224245import Data.IORef
225246import Data.Kind (Constraint, Type)
226−import Data.List (nubBy, foldl')
247+import Data.List (foldl', nubBy)
227248import Data.List.NonEmpty (NonEmpty (..))
249+import qualified Data.List.NonEmpty as NE
228250import Data.Maybe (fromMaybe)
229251import Data.Proxy
230252import Data.Semigroup hiding (Option, option)
231253import Data.Text (Text)
254+import qualified Data.Text.Encoding as T
232255import Data.Typeable (Typeable)
233256import GHC.Generics
234257import GHC.TypeLits
258+import qualified Network.Connection as NC
259+import qualified Network.HTTP.Client as L
260+import qualified Network.HTTP.Client.Internal as LI
261+import qualified Network.HTTP.Client.MultipartFormData as LM
262+import qualified Network.HTTP.Client.TLS as L
263+import qualified Network.HTTP.Types as Y
235264import System.IO.Unsafe (unsafePerformIO)
236265import Text.URI (URI)
266+import qualified Text.URI as URI
267+import qualified Text.URI.QQ as QQ
268+import qualified Web.Authenticate.OAuth as OAuth
237269import Web.HttpApiData (ToHttpApiData (..))
238−import qualified Blaze.ByteString.Builder as BB
239−import qualified Data.Aeson as A
240−import qualified Data.ByteString as B
241−import qualified Data.ByteString.Lazy as BL
242−import qualified Data.CaseInsensitive as CI
243−import qualified Data.List.NonEmpty as NE
244−import qualified Data.Text.Encoding as T
245−import qualified Network.Connection as NC
246−import qualified Network.HTTP.Client as L
247−import qualified Network.HTTP.Client.Internal as LI
248−import qualified Network.HTTP.Client.MultipartFormData as LM
249−import qualified Network.HTTP.Client.TLS as L
250−import qualified Network.HTTP.Types as Y
251−import qualified Text.URI as URI
252−import qualified Text.URI.QQ as QQ
253−import qualified Web.Authenticate.OAuth as OAuth
254270
255271----------------------------------------------------------------------------
256272-- Making a request
@@ -382,19 +398,25 @@ import qualified Web.Authenticate.OAuth as OAuth
382398-- > options <> -- contains the ?foo=bar part
383399-- > port 443 -- here you can put any port of course
384400-- > liftIO $ print (responseBody response :: Value)
385−
386−req
387− :: ( MonadHttp m
388− , HttpMethod method
389− , HttpBody body
390− , HttpResponse response
391− , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )
392− => method -- ^ HTTP method
393− -> Url scheme -- ^ 'Url'—location of resource
394− -> body -- ^ Body of the request
395− -> Proxy response -- ^ A hint how to interpret response
396− -> Option scheme -- ^ Collection of optional parameters
397− -> m response -- ^ Response
401+req ::
402+ ( MonadHttp m,
403+ HttpMethod method,
404+ HttpBody body,
405+ HttpResponse response,
406+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
407+ ) =>
408+ -- | HTTP method
409+ method ->
410+ -- | 'Url'—location of resource
411+ Url scheme ->
412+ -- | Body of the request
413+ body ->
414+ -- | A hint how to interpret response
415+ Proxy response ->
416+ -- | Collection of optional parameters
417+ Option scheme ->
418+ -- | Response
419+ m response
398420req method url body responseProxy options =
399421 reqBr method url body (options <> extraOptions) getHttpResponse
400422 where
@@ -408,39 +430,49 @@ req method url body responseProxy options =
408430-- 'L.BodyReader'@ manually, in a custom way.
409431--
410432-- @since 1.0.0
411−
412−reqBr
413− :: ( MonadHttp m
414− , HttpMethod method
415− , HttpBody body
416− , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )
417− => method -- ^ HTTP method
418− -> Url scheme -- ^ 'Url'—location of resource
419− -> body -- ^ Body of the request
420− -> Option scheme -- ^ Collection of optional parameters
421− -> (L.Response L.BodyReader -> IO a) -- ^ How to consume response
422− -> m a -- ^ Result
433+reqBr ::
434+ ( MonadHttp m,
435+ HttpMethod method,
436+ HttpBody body,
437+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
438+ ) =>
439+ -- | HTTP method
440+ method ->
441+ -- | 'Url'—location of resource
442+ Url scheme ->
443+ -- | Body of the request
444+ body ->
445+ -- | Collection of optional parameters
446+ Option scheme ->
447+ -- | How to consume response
448+ (L.Response L.BodyReader -> IO a) ->
449+ -- | Result
450+ m a
423451reqBr method url body options consume = req' method url body options $ \request manager -> do
424− HttpConfig {..} <- getHttpConfig
452+ HttpConfig {..} <- getHttpConfig
425453 let wrapVanilla = handle (throwIO . VanillaHttpException)
426− wrapExc = handle (throwIO . LI.toHttpException request)
427− withRRef = bracket
428− (newIORef Nothing)
429− (readIORef >=> mapM_ L.responseClose)
430− (liftIO . try . wrapVanilla . wrapExc) (withRRef $ \rref -> do
431− let openResponse = mask_ $ do
432− r <- readIORef rref
433− mapM_ L.responseClose r
434− r' <- L.responseOpen request manager
435− writeIORef rref (Just r')
436− return r'
437− r <- retrying
438− httpConfigRetryPolicy
439− (\st r -> return $ httpConfigRetryJudge st r)
440− (const openResponse)
441− (preview, r') <- grabPreview bodyPreviewLength r
442− mapM_ LI.throwHttp (httpConfigCheckResponse request r' preview)
443− consume r')
454+ wrapExc = handle (throwIO . LI.toHttpException request)
455+ withRRef =
456+ bracket
457+ (newIORef Nothing)
458+ (readIORef >=> mapM_ L.responseClose)
459+ (liftIO . try . wrapVanilla . wrapExc)
460+ ( withRRef $ \rref -> do
461+ let openResponse = mask_ $ do
462+ r <- readIORef rref
463+ mapM_ L.responseClose r
464+ r' <- L.responseOpen request manager
465+ writeIORef rref (Just r')
466+ return r'
467+ r <-
468+ retrying
469+ httpConfigRetryPolicy
470+ (\st r -> return $ httpConfigRetryJudge st r)
471+ (const openResponse)
472+ (preview, r') <- grabPreview bodyPreviewLength r
473+ mapM_ LI.throwHttp (httpConfigCheckResponse request r' preview)
474+ consume r'
475+ )
444476 >>= either handleHttpException return
445477
446478-- | Mostly like 'req' with respect to its arguments, but accepts a callback
@@ -451,44 +483,50 @@ reqBr method url body options consume = req' method url body options $ \request
451483-- 'L.Request' and allows you to use it.
452484--
453485-- @since 0.3.0
454−
455−req'
456− :: forall m method body scheme a.
457− ( MonadHttp m
458− , HttpMethod method
459− , HttpBody body
460− , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )
461− => method -- ^ HTTP method
462− -> Url scheme -- ^ 'Url'—location of resource
463− -> body -- ^ Body of the request
464− -> Option scheme -- ^ Collection of optional parameters
465− -> (L.Request -> L.Manager -> m a) -- ^ How to perform request
466− -> m a -- ^ Result
486+req' ::
487+ forall m method body scheme a.
488+ ( MonadHttp m,
489+ HttpMethod method,
490+ HttpBody body,
491+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
492+ ) =>
493+ -- | HTTP method
494+ method ->
495+ -- | 'Url'—location of resource
496+ Url scheme ->
497+ -- | Body of the request
498+ body ->
499+ -- | Collection of optional parameters
500+ Option scheme ->
501+ -- | How to perform request
502+ (L.Request -> L.Manager -> m a) ->
503+ -- | Result
504+ m a
467505req' method url body options m = do
468506 config <- getHttpConfig
469507 let -- NOTE First appearance of any given header wins. This allows to
470508 -- “overwrite” headers when we construct a request by cons-ing.
471509 nubHeaders = Endo $ \x ->
472− x { L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x) }
473− request' = flip appEndo L.defaultRequest $
474− -- NOTE The order of 'mappend's matters, here method is overwritten
475− -- first and 'options' take effect last. In particular, this means
476− -- that 'options' can overwrite things set by other request
477− -- components, which is useful for setting port number,
478− -- "Content-Type" header, etc.
479− nubHeaders <>
480− getRequestMod options <>
481− getRequestMod config <>
482− getRequestMod (Womb body :: Womb "body" body) <>
483− getRequestMod url <>
484− getRequestMod (Womb method :: Womb "method" method)
510+ x {L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x)}
511+ request' =
512+ flip appEndo L.defaultRequest $
513+ -- NOTE The order of 'mappend's matters, here method is overwritten
514+ -- first and 'options' take effect last. In particular, this means
515+ -- that 'options' can overwrite things set by other request
516+ -- components, which is useful for setting port number,
517+ -- "Content-Type" header, etc.
518+ nubHeaders
519+ <> getRequestMod options
520+ <> getRequestMod config
521+ <> getRequestMod (Womb body :: Womb "body" body)
522+ <> getRequestMod url
523+ <> getRequestMod (Womb method :: Womb "method" method)
485524 request <- finalizeRequest options request'
486525 withReqManager (m request)
487526
488527-- | Perform an action using the global implicit 'L.Manager' that the rest
489528-- of the library uses. This allows to reuse connections that the
490529-- 'L.Manager' controls.
491−
492530withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
493531withReqManager m = liftIO (readIORef globalManager) >>= m
494532
@@ -503,14 +541,14 @@ withReqManager m = liftIO (readIORef globalManager) >>= m
503541-- manager. From that moment on the 'IORef' will be just reused—exactly the
504542-- behavior we want here in order to maximize connection sharing. GHC could
505543-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
506−
507544globalManager :: IORef L.Manager
508545globalManager = unsafePerformIO $ do
509546 context <- NC.initConnectionContext
510− let settings = L.mkManagerSettingsContext
511− (Just context)
512− (NC.TLSSettingsSimple False False False)
513− Nothing
547+ let settings =
548+ L.mkManagerSettingsContext
549+ (Just context)
550+ (NC.TLSSettingsSimple False False False)
551+ Nothing
514552 manager <- L.newManager settings
515553 newIORef manager
516554{-# NOINLINE globalManager #-}
@@ -532,15 +570,12 @@ globalManager = unsafePerformIO $ do
532570-- | A type class for monads that support performing HTTP requests.
533571-- Typically, you only need to define the 'handleHttpException' method
534572-- unless you want to tweak 'HttpConfig'.
535−
536573class MonadIO m => MonadHttp m where
537−
538574 -- | This method describes how to deal with 'HttpException' that was
539575 -- caught by the library. One option is to re-throw it if you are OK with
540576 -- exceptions, but if you prefer working with something like
541577 -- 'Control.Monad.Except.MonadError', this is the right place to pass it to
542578 -- 'Control.Monad.Except.throwError'.
543−
544579 handleHttpException :: HttpException -> m a
545580
546581 -- | Return 'HttpConfig' to be used when performing HTTP requests. Default
@@ -549,32 +584,24 @@ class MonadIO m => MonadHttp m where
549584 -- 'getHttpConfig' is to return some hard-coded value, or a value
550585 -- extracted from 'Control.Monad.Reader.MonadReader' if a more flexible
551586 -- approach to configuration is desirable.
552−
553587 getHttpConfig :: m HttpConfig
554588 getHttpConfig = return defaultHttpConfig
555589
556590-- | 'HttpConfig' contains general and default settings to be used when
557591-- making HTTP requests.
558−
559592data HttpConfig = HttpConfig
560− { httpConfigProxy :: Maybe L.Proxy
561− -- ^ Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
593+ { -- | Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
562594 -- environment variables are respected, this setting overwrites them.
563595 -- Default value: 'Nothing'.
564− , httpConfigRedirectCount :: Int
565− -- ^ How many redirects to follow when getting a resource. Default
596+ httpConfigProxy :: Maybe L.Proxy,
597+ -- | How many redirects to follow when getting a resource. Default
566598 -- value: 10.
567− , httpConfigAltManager :: Maybe L.Manager
568− -- ^ Alternative 'L.Manager' to use. 'Nothing' (default value) means
599+ httpConfigRedirectCount :: Int,
600+ -- | Alternative 'L.Manager' to use. 'Nothing' (default value) means
569601 -- that the default implicit manager will be used (that's what you want
570602 -- in 99% of cases).
571− , httpConfigCheckResponse
572− :: forall b.
573− L.Request
574− -> L.Response b
575− -> ByteString
576− -> Maybe L.HttpExceptionContent
577− -- ^ Function to check the response immediately after receiving the
603+ httpConfigAltManager :: Maybe L.Manager,
604+ -- | Function to check the response immediately after receiving the
578605 -- status and headers, before streaming of response body. The third
579606 -- argument is the beginning of response body (typically first 1024
580607 -- bytes). This is used for throwing exceptions on non-success status
@@ -596,67 +623,77 @@ data HttpConfig = HttpConfig
596623 -- /1.0.0/.
597624 --
598625 -- @since 0.3.0
599− , httpConfigRetryPolicy :: RetryPolicyM IO
600− -- ^ The retry policy to use for request retrying. By default 'def' is
626+ httpConfigCheckResponse ::
627+ forall b.
628+ L.Request ->
629+ L.Response b ->
630+ ByteString ->
631+ Maybe L.HttpExceptionContent,
632+ -- | The retry policy to use for request retrying. By default 'def' is
601633 -- used (see 'RetryPolicyM').
602634 --
603635 -- __Note__: signature of this function was changed in the version
604636 -- /1.0.0/.
605637 --
606638 -- @since 0.3.0
607− , httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool
608− -- ^ The function is used to decide whether to retry a request. 'True'
639+ httpConfigRetryPolicy :: RetryPolicyM IO,
640+ -- | The function is used to decide whether to retry a request. 'True'
609641 -- means that the request should be retried.
610642 --
611643 -- __Note__: signature of this function was changed in the version
612644 -- /1.0.0/.
613645 --
614646 -- @since 0.3.0
615− } deriving Typeable
647+ httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool
648+ }
649+ deriving (Typeable)
616650
617651-- | Default value of 'HttpConfig'.
618652--
619653-- @since 2.0.0
620−
621654defaultHttpConfig :: HttpConfig
622−defaultHttpConfig = HttpConfig
623− { httpConfigProxy = Nothing
624− , httpConfigRedirectCount = 10
625− , httpConfigAltManager = Nothing
626− , httpConfigCheckResponse = \_ response preview ->
627− let scode = statusCode response
628− in if 200 <= scode && scode < 300
629− then Nothing
630− else Just (L.StatusCodeException (void response) preview)
631− , httpConfigRetryPolicy = retryPolicyDefault
632− , httpConfigRetryJudge = \_ response ->
633− statusCode response `elem`
634− [ 408 -- Request timeout
635− , 504 -- Gateway timeout
636− , 524 -- A timeout occurred
637− , 598 -- (Informal convention) Network read timeout error
638− , 599 -- (Informal convention) Network connect timeout error
639− ]
640− }
655+defaultHttpConfig =
656+ HttpConfig
657+ { httpConfigProxy = Nothing,
658+ httpConfigRedirectCount = 10,
659+ httpConfigAltManager = Nothing,
660+ httpConfigCheckResponse = \_ response preview ->
661+ let scode = statusCode response
662+ in if 200 <= scode && scode < 300
663+ then Nothing
664+ else Just (L.StatusCodeException (void response) preview),
665+ httpConfigRetryPolicy = retryPolicyDefault,
666+ httpConfigRetryJudge = \_ response ->
667+ statusCode response
668+ `elem` [ 408, -- Request timeout
669+ 504, -- Gateway timeout
670+ 524, -- A timeout occurred
671+ 598, -- (Informal convention) Network read timeout error
672+ 599 -- (Informal convention) Network connect timeout error
673+ ]
674+ }
641675 where
642676 statusCode = Y.statusCode . L.responseStatus
643677
644678instance RequestComponent HttpConfig where
645679 getRequestMod HttpConfig {..} = Endo $ \x ->
646− x { L.proxy = httpConfigProxy
647− , L.redirectCount = httpConfigRedirectCount
648− , LI.requestManagerOverride = httpConfigAltManager }
680+ x
681+ { L.proxy = httpConfigProxy,
682+ L.redirectCount = httpConfigRedirectCount,
683+ LI.requestManagerOverride = httpConfigAltManager
684+ }
649685
650686-- | A monad that allows to run 'req' in any 'IO'-enabled monad without
651687-- having to define new instances.
652688--
653689-- @since 0.4.0
654−
655690newtype Req a = Req (ReaderT HttpConfig IO a)
656− deriving ( Functor
657− , Applicative
658− , Monad
659− , MonadIO )
691+ deriving
692+ ( Functor,
693+ Applicative,
694+ Monad,
695+ MonadIO
696+ )
660697
661698instance MonadBase IO Req where
662699 liftBase = liftIO
@@ -665,22 +702,24 @@ instance MonadBaseControl IO Req where
665702 type StM Req a = a
666703 liftBaseWith f = Req . ReaderT $ \r -> f (runReq r)
667704 {-# INLINEABLE liftBaseWith #-}
668− restoreM = Req . ReaderT . const . return
705+ restoreM = Req . ReaderT . const . return
669706 {-# INLINEABLE restoreM #-}
670707
671708instance MonadHttp Req where
672709 handleHttpException = Req . lift . throwIO
673− getHttpConfig = Req ask
710+ getHttpConfig = Req ask
674711
675712-- | Run a computation in the 'Req' monad with the given 'HttpConfig'. In
676713-- case of exceptional situation an 'HttpException' will be thrown.
677714--
678715-- @since 0.4.0
679−
680−runReq :: MonadIO m
681− => HttpConfig -- ^ 'HttpConfig' to use
682− -> Req a -- ^ Computation to run
683− -> m a
716+runReq ::
717+ MonadIO m =>
718+ -- | 'HttpConfig' to use
719+ HttpConfig ->
720+ -- | Computation to run
721+ Req a ->
722+ m a
684723runReq config (Req m) = liftIO (runReaderT m config)
685724
686725----------------------------------------------------------------------------
@@ -696,7 +735,6 @@ runReq config (Req m) = liftIO (runReaderT m config)
696735-- define a new method that will works seamlessly, see 'HttpMethod'.
697736
698737-- | 'GET' method.
699−
700738data GET = GET
701739
702740instance HttpMethod GET where
@@ -704,7 +742,6 @@ instance HttpMethod GET where
704742 httpMethodName Proxy = Y.methodGet
705743
706744-- | 'POST' method.
707−
708745data POST = POST
709746
710747instance HttpMethod POST where
@@ -712,7 +749,6 @@ instance HttpMethod POST where
712749 httpMethodName Proxy = Y.methodPost
713750
714751-- | 'HEAD' method.
715−
716752data HEAD = HEAD
717753
718754instance HttpMethod HEAD where
@@ -720,7 +756,6 @@ instance HttpMethod HEAD where
720756 httpMethodName Proxy = Y.methodHead
721757
722758-- | 'PUT' method.
723−
724759data PUT = PUT
725760
726761instance HttpMethod PUT where
@@ -731,7 +766,6 @@ instance HttpMethod PUT where
731766-- 'DELETE' requests, as it should be. However some APIs may expect 'DELETE'
732767-- requests to have bodies, in that case define your own variation of
733768-- 'DELETE' method and allow it to have a body.
734−
735769data DELETE = DELETE
736770
737771instance HttpMethod DELETE where
@@ -739,7 +773,6 @@ instance HttpMethod DELETE where
739773 httpMethodName Proxy = Y.methodDelete
740774
741775-- | 'TRACE' method.
742−
743776data TRACE = TRACE
744777
745778instance HttpMethod TRACE where
@@ -747,7 +780,6 @@ instance HttpMethod TRACE where
747780 httpMethodName Proxy = Y.methodTrace
748781
749782-- | 'CONNECT' method.
750−
751783data CONNECT = CONNECT
752784
753785instance HttpMethod CONNECT where
@@ -755,7 +787,6 @@ instance HttpMethod CONNECT where
755787 httpMethodName Proxy = Y.methodConnect
756788
757789-- | 'OPTIONS' method.
758−
759790data OPTIONS = OPTIONS
760791
761792instance HttpMethod OPTIONS where
@@ -763,7 +794,6 @@ instance HttpMethod OPTIONS where
763794 httpMethodName Proxy = Y.methodOptions
764795
765796-- | 'PATCH' method.
766−
767797data PATCH = PATCH
768798
769799instance HttpMethod PATCH where
@@ -778,23 +808,19 @@ instance HttpMethod PATCH where
778808-- > instance HttpMethod COPY where
779809-- > type AllowsBody COPY = 'CanHaveBody
780810-- > httpMethodName Proxy = "COPY"
781−
782811class HttpMethod a where
783−
784812 -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which
785813 -- tells the rest of the library whether the method can have body or not.
786814 -- We use the special type 'CanHaveBody' lifted to the kind level instead
787815 -- of 'Bool' to get more user-friendly compiler messages.
788−
789816 type AllowsBody a :: CanHaveBody
790817
791818 -- | Return name of the method as a 'ByteString'.
792−
793819 httpMethodName :: Proxy a -> ByteString
794820
795821instance HttpMethod method => RequestComponent (Womb "method" method) where
796822 getRequestMod _ = Endo $ \x ->
797− x { L.method = httpMethodName (Proxy :: Proxy method) }
823+ x {L.method = httpMethodName (Proxy :: Proxy method)}
798824
799825----------------------------------------------------------------------------
800826-- Request—URL
@@ -832,34 +858,31 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where
832858--
833859-- > https "юникод.рф"
834860-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
835−
836861data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
837862 -- NOTE The second value is the path segments in reversed order.
838863 deriving (Eq, Ord, Show, Data, Typeable, Generic)
839864
840865-- | Given host name, produce a 'Url' which has “http” as its scheme and
841866-- empty path. This also sets port to @80@.
842−
843867http :: Text -> Url 'Http
844868http = Url Http . pure
845869
846870-- | Given host name, produce a 'Url' which has “https” as its scheme and
847871-- empty path. This also sets port to @443@.
848−
849872https :: Text -> Url 'Https
850873https = Url Https . pure
851874
852875-- | Grow given 'Url' appending a single path segment to it. Note that the
853876-- path segment can be of any type that is an instance of 'ToHttpApiData'.
854−
855877infixl 5 /~
878+
856879(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
857880Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
858881
859882-- | Type-constrained version of @('/~')@ to remove ambiguity in the cases
860883-- when next URL piece is a 'Data.Text.Text' literal.
861−
862884infixl 5 /:
885+
863886(/:) :: Url scheme -> Text -> Url scheme
864887(/:) = (/~)
865888
@@ -870,7 +893,6 @@ infixl 5 /:
870893-- This function expects the scheme to be “http” and host to be present.
871894--
872895-- @since 3.0.0
873−
874896useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)
875897useHttpURI uri = do
876898 guard (URI.uriScheme uri == Just [QQ.scheme|http|])
@@ -884,7 +906,6 @@ useHttpURI uri = do
884906-- | Just like 'useHttpURI', but expects the “https” scheme.
885907--
886908-- @since 3.0.0
887−
888909useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)
889910useHttpsURI uri = do
890911 guard (URI.uriScheme uri == Just [QQ.scheme|https|])
@@ -899,16 +920,17 @@ useHttpsURI uri = do
899920-- is not known in advance.
900921--
901922-- @since 3.0.0
902−
903−useURI
904− :: URI
905− -> Maybe (Either (Url 'Http, Option scheme0)
906− (Url 'Https, Option scheme1))
923+useURI ::
924+ URI ->
925+ Maybe
926+ ( Either
927+ (Url 'Http, Option scheme0)
928+ (Url 'Https, Option scheme1)
929+ )
907930useURI uri =
908931 (Left <$> useHttpURI uri) <|> (Right <$> useHttpsURI uri)
909932
910933-- | An internal helper function to extract host from a 'URI'.
911−
912934uriHost :: URI -> Maybe Text
913935uriHost uri = case URI.uriAuthority uri of
914936 Left _ -> Nothing
@@ -916,14 +938,14 @@ uriHost uri = case URI.uriAuthority uri of
916938 Just (URI.unRText authHost)
917939
918940-- | An internal helper function to extract 'Option's from a 'URI'.
919−
920941uriOptions :: forall scheme. URI -> Option scheme
921−uriOptions uri = mconcat
922− [ auth
923− , query
924− , port'
925− -- , fragment'
926− ]
942+uriOptions uri =
943+ mconcat
944+ [ auth,
945+ query,
946+ port'
947+ -- , fragment'
948+ ]
927949 where
928950 (auth, port') =
929951 case URI.uriAuthority uri of
@@ -934,34 +956,37 @@ uriOptions uri = mconcat
934956 Just URI.UserInfo {..} ->
935957 let username = T.encodeUtf8 (URI.unRText uiUsername)
936958 password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword
937− in basicAuthUnsafe username password
959+ in basicAuthUnsafe username password
938960 port0 = case authPort of
939961 Nothing -> mempty
940962 Just port'' -> port (fromIntegral port'')
941− in (auth0, port0)
963+ in (auth0, port0)
942964 query =
943965 let liftQueryParam = \case
944966 URI.QueryFlag t -> queryFlag (URI.unRText t)
945967 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'')
968+ in mconcat (liftQueryParam <$> URI.uriQuery uri)
969+
970+-- TODO Blocked on upstream: https://github.com/snoyberg/http-client/issues/424
971+-- fragment' =
972+-- case URI.uriFragment uri of
973+-- Nothing -> mempty
974+-- Just fragment'' -> fragment (URI.unRText fragment'')
952975
953976instance RequestComponent (Url scheme) where
954977 getRequestMod (Url scheme segments) = Endo $ \x ->
955− let (host :| path) = NE.reverse segments in
956− x { L.secure = case scheme of
957− Http -> False
958− Https -> True
959− , L.port = case scheme of
960− Http -> 80
961− Https -> 443
962− , L.host = Y.urlEncode False (T.encodeUtf8 host)
963− , L.path =
964− (BL.toStrict . BB.toLazyByteString . Y.encodePathSegments) path }
978+ let (host :| path) = NE.reverse segments
979+ in x
980+ { L.secure = case scheme of
981+ Http -> False
982+ Https -> True,
983+ L.port = case scheme of
984+ Http -> 80
985+ Https -> 443,
986+ L.host = Y.urlEncode False (T.encodeUtf8 host),
987+ L.path =
988+ (BL.toStrict . BB.toLazyByteString . Y.encodePathSegments) path
989+ }
965990
966991----------------------------------------------------------------------------
967992-- Request—Body
@@ -979,7 +1004,6 @@ instance RequestComponent (Url scheme) where
9791004-- only type for which 'ProvidesBody' returns 'NoBody'.
9801005--
9811006-- Using of this body option does not set the @Content-Type@ header.
982−
9831007data NoReqBody = NoReqBody
9841008
9851009instance HttpBody NoReqBody where
@@ -992,7 +1016,6 @@ instance HttpBody NoReqBody where
9921016--
9931017-- This body option sets the @Content-Type@ header to @\"application/json;
9941018-- charset=utf-8\"@ value.
995−
9961019newtype ReqBodyJson a = ReqBodyJson a
9971020
9981021instance ToJSON a => HttpBody (ReqBodyJson a) where
@@ -1003,7 +1026,6 @@ instance ToJSON a => HttpBody (ReqBodyJson a) where
10031026-- the file size does not change during the streaming.
10041027--
10051028-- Using of this body option does not set the @Content-Type@ header.
1006−
10071029newtype ReqBodyFile = ReqBodyFile FilePath
10081030
10091031instance HttpBody ReqBodyFile where
@@ -1013,7 +1035,6 @@ instance HttpBody ReqBodyFile where
10131035-- | HTTP request body represented by a strict 'ByteString'.
10141036--
10151037-- Using of this body option does not set the @Content-Type@ header.
1016−
10171038newtype ReqBodyBs = ReqBodyBs ByteString
10181039
10191040instance HttpBody ReqBodyBs where
@@ -1022,7 +1043,6 @@ instance HttpBody ReqBodyBs where
10221043-- | HTTP request body represented by a lazy 'BL.ByteString'.
10231044--
10241045-- Using of this body option does not set the @Content-Type@ header.
1025−
10261046newtype ReqBodyLbs = ReqBodyLbs BL.ByteString
10271047
10281048instance HttpBody ReqBodyLbs where
@@ -1037,7 +1057,6 @@ instance HttpBody ReqBodyLbs where
10371057--
10381058-- This body option sets the @Content-Type@ header to
10391059-- @\"application/x-www-form-urlencoded\"@ value.
1040−
10411060newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam
10421061
10431062instance HttpBody ReqBodyUrlEnc where
@@ -1047,7 +1066,6 @@ instance HttpBody ReqBodyUrlEnc where
10471066
10481067-- | An opaque monoidal value that allows to collect URL-encoded parameters
10491068-- to be wrapped in 'ReqBodyUrlEnc'.
1050−
10511069newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]
10521070 deriving (Semigroup, Monoid)
10531071
@@ -1083,7 +1101,6 @@ instance QueryParam FormUrlEncodedParam where
10831101-- > bsResponse
10841102-- > mempty
10851103-- > liftIO $ print (responseBody response)
1086−
10871104data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody
10881105
10891106instance HttpBody ReqBodyMultipart where
@@ -1094,36 +1111,30 @@ instance HttpBody ReqBodyMultipart where
10941111-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
10951112--
10961113-- @since 0.2.0
1097−
10981114reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
10991115reqBodyMultipart parts = liftIO $ do
11001116 boundary <- LM.webkitBoundary
1101− body <- LM.renderParts boundary parts
1117+ body <- LM.renderParts boundary parts
11021118 return (ReqBodyMultipart boundary body)
11031119
11041120-- | A type class for things that can be interpreted as an HTTP
11051121-- 'L.RequestBody'.
1106−
11071122class HttpBody body where
1108−
11091123 -- | How to get actual 'L.RequestBody'.
1110−
11111124 getRequestBody :: body -> L.RequestBody
11121125
11131126 -- | This method allows us to optionally specify the value of
11141127 -- @Content-Type@ header that should be used with particular body option.
11151128 -- By default it returns 'Nothing' and so @Content-Type@ is not set.
1116−
11171129 getRequestContentType :: body -> Maybe ByteString
11181130 getRequestContentType = const Nothing
11191131
11201132-- | The type function recognizes 'NoReqBody' as having 'NoBody', while any
11211133-- other body option 'CanHaveBody'. This forces the user to use 'NoReqBody'
11221134-- with 'GET' method and other methods that should not have body.
1123−
11241135type family ProvidesBody body :: CanHaveBody where
11251136 ProvidesBody NoReqBody = 'NoBody
1126− ProvidesBody body = 'CanHaveBody
1137+ ProvidesBody body = 'CanHaveBody
11271138
11281139-- | This type function allows any HTTP body if method says it
11291140-- 'CanHaveBody'. When the method says it should have 'NoBody', the only
@@ -1131,24 +1142,29 @@ type family ProvidesBody body :: CanHaveBody where
11311142--
11321143-- __Note__: users of GHC 8.0.1 and later will see a slightly more friendly
11331144-- error message when method does not allow a body and body is provided.
1134−
1135−type family HttpBodyAllowed
1136− (allowsBody :: CanHaveBody)
1137− (providesBody :: CanHaveBody) :: Constraint where
1138− HttpBodyAllowed 'NoBody 'NoBody = ()
1139− HttpBodyAllowed 'CanHaveBody body = ()
1140− HttpBodyAllowed 'NoBody 'CanHaveBody = TypeError
1141− ('Text "This HTTP method does not allow attaching a request body.")
1145+type family
1146+ HttpBodyAllowed
1147+ (allowsBody :: CanHaveBody)
1148+ (providesBody :: CanHaveBody) ::
1149+ Constraint
1150+ where
1151+ HttpBodyAllowed 'NoBody 'NoBody = ()
1152+ HttpBodyAllowed 'CanHaveBody body = ()
1153+ HttpBodyAllowed 'NoBody 'CanHaveBody =
1154+ TypeError
1155+ ('Text "This HTTP method does not allow attaching a request body.")
11421156
11431157instance HttpBody body => RequestComponent (Womb "body" body) where
11441158 getRequestMod (Womb body) = Endo $ \x ->
1145− x { L.requestBody = getRequestBody body
1146− , L.requestHeaders =
1147− let old = L.requestHeaders x in
1148− case getRequestContentType body of
1149− Nothing -> old
1150− Just contentType ->
1151− (Y.hContentType, contentType) : old }
1159+ x
1160+ { L.requestBody = getRequestBody body,
1161+ L.requestHeaders =
1162+ let old = L.requestHeaders x
1163+ in case getRequestContentType body of
1164+ Nothing -> old
1165+ Just contentType ->
1166+ (Y.hContentType, contentType) : old
1167+ }
11521168
11531169----------------------------------------------------------------------------
11541170-- Request—Optional parameters
@@ -1164,45 +1180,44 @@ instance HttpBody body => RequestComponent (Womb "body" body) where
11641180-- | The opaque 'Option' type is a 'Monoid' you can use to pack collection
11651181-- of optional parameters like query parameters and headers. See sections
11661182-- below to learn which 'Option' primitives are available.
1183+data Option (scheme :: Scheme)
1184+ = Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))
11671185
1168−data Option (scheme :: Scheme) =
1169− Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))
1170− -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
1171− -- Request to avoid appending to existing query string in request every
1172− -- time new parameter is added. Additional Maybe (L.Request -> IO
1173− -- L.Request) is a finalizer that will be applied after all other
1174− -- transformations. This is for authentication methods that sign requests
1175− -- based on data in Request.
1186+-- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
1187+-- Request to avoid appending to existing query string in request every
1188+-- time new parameter is added. Additional Maybe (L.Request -> IO
1189+-- L.Request) is a finalizer that will be applied after all other
1190+-- transformations. This is for authentication methods that sign requests
1191+-- based on data in Request.
11761192
11771193instance Semigroup (Option scheme) where
1178− Option er0 mr0 <> Option er1 mr1 = Option
1179− (er0 <> er1) (mr0 <|> mr1)
1194+ Option er0 mr0 <> Option er1 mr1 =
1195+ Option
1196+ (er0 <> er1)
1197+ (mr0 <|> mr1)
11801198
11811199instance Monoid (Option scheme) where
1182− mempty = Option mempty Nothing
1200+ mempty = Option mempty Nothing
11831201 mappend = (<>)
11841202
11851203-- | A helper to create an 'Option' that modifies only collection of query
11861204-- parameters. This helper is not a part of the public API.
1187−
11881205withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
11891206withQueryParams f = Option (Endo (first f)) Nothing
11901207
11911208-- | A helper to create an 'Option' that modifies only 'L.Request'. This
11921209-- helper is not a part of public API.
1193−
11941210withRequest :: (L.Request -> L.Request) -> Option scheme
11951211withRequest f = Option (Endo (second f)) Nothing
11961212
11971213instance RequestComponent (Option scheme) where
11981214 getRequestMod (Option f _) = Endo $ \x ->
11991215 let (qparams, x') = appEndo f ([], x)
1200− query = Y.renderQuery True (Y.queryTextToQuery qparams)
1201− in x' { L.queryString = query }
1216+ query = Y.renderQuery True (Y.queryTextToQuery qparams)
1217+ in x' {L.queryString = query}
12021218
12031219-- | Finalize given 'L.Request' by applying a finalizer from the given
12041220-- 'Option' (if it has any).
1205−
12061221finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
12071222finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
12081223
@@ -1222,8 +1237,8 @@ finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
12221237-- This operator is defined in terms of 'queryParam':
12231238--
12241239-- > name =: value = queryParam name (pure value)
1225−
12261240infix 7 =:
1241+
12271242(=:) :: (QueryParam param, ToHttpApiData a) => Text -> a -> param
12281243name =: value = queryParam name (pure value)
12291244
@@ -1236,7 +1251,6 @@ name =: value = queryParam name (pure value)
12361251-- This operator is defined in terms of 'queryParam':
12371252--
12381253-- > queryFlag name = queryParam name (Nothing :: Maybe ())
1239−
12401254queryFlag :: QueryParam param => Text -> param
12411255queryFlag name = queryParam name (Nothing :: Maybe ())
12421256
@@ -1244,14 +1258,11 @@ queryFlag name = queryParam name (Nothing :: Maybe ())
12441258-- overloaded 'queryParam' is to be able to use it as an 'Option' and as a
12451259-- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.
12461260-- Having the same syntax for these cases seems natural and user-friendly.
1247−
12481261class QueryParam param where
1249−
12501262 -- | Create a query parameter with given name and value. If value is
12511263 -- 'Nothing', it won't be included at all (i.e. you create a flag this
12521264 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
12531265 -- method, because they are easier to read.
1254−
12551266 queryParam :: ToHttpApiData a => Text -> Maybe a -> param
12561267
12571268instance QueryParam (Option scheme) where
@@ -1265,20 +1276,20 @@ instance QueryParam (Option scheme) where
12651276-- headers with the same names the leftmost header will win. This means, in
12661277-- particular, that you cannot create a request with several headers of the
12671278-- same name.
1268−
1269−header
1270− :: ByteString -- ^ Header name
1271− -> ByteString -- ^ Header value
1272− -> Option scheme
1279+header ::
1280+ -- | Header name
1281+ ByteString ->
1282+ -- | Header value
1283+ ByteString ->
1284+ Option scheme
12731285header name value = withRequest (attachHeader name value)
12741286
12751287-- | Attach a header with given name and content to a 'L.Request'.
12761288--
12771289-- @since 1.1.0
1278−
12791290attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
12801291attachHeader name value x =
1281− x { L.requestHeaders = (CI.mk name, value) : L.requestHeaders x }
1292+ x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
12821293
12831294----------------------------------------------------------------------------
12841295-- Request—Optional parameters—Cookies
@@ -1291,10 +1302,9 @@ attachHeader name value x =
12911302
12921303-- | Use the given 'L.CookieJar'. A 'L.CookieJar' can be obtained from a
12931304-- 'L.Response' record.
1294−
12951305cookieJar :: L.CookieJar -> Option scheme
12961306cookieJar jar = withRequest $ \x ->
1297− x { L.cookieJar = Just jar }
1307+ x {L.cookieJar = Just jar}
12981308
12991309----------------------------------------------------------------------------
13001310-- Request—Optional parameters—Authentication
@@ -1312,11 +1322,13 @@ cookieJar jar = withRequest $ \x ->
13121322-- | The 'Option' adds basic authentication.
13131323--
13141324-- See also: <https://en.wikipedia.org/wiki/Basic_access_authentication>.
1315−
1316−basicAuth
1317− :: ByteString -- ^ Username
1318− -> ByteString -- ^ Password
1319− -> Option 'Https -- ^ Auth 'Option'
1325+basicAuth ::
1326+ -- | Username
1327+ ByteString ->
1328+ -- | Password
1329+ ByteString ->
1330+ -- | Auth 'Option'
1331+ Option 'Https
13201332basicAuth = basicAuthUnsafe
13211333
13221334-- | An alternative to 'basicAuth' which works for any scheme. Note that
@@ -1324,41 +1336,52 @@ basicAuth = basicAuthUnsafe
13241336-- attacks. Use 'basicAuth' instead unless you know what you are doing.
13251337--
13261338-- @since 0.3.1
1327−
1328−basicAuthUnsafe
1329− :: ByteString -- ^ Username
1330− -> ByteString -- ^ Password
1331− -> Option scheme -- ^ Auth 'Option'
1332−basicAuthUnsafe username password = customAuth
1333− (pure . L.applyBasicAuth username password)
1339+basicAuthUnsafe ::
1340+ -- | Username
1341+ ByteString ->
1342+ -- | Password
1343+ ByteString ->
1344+ -- | Auth 'Option'
1345+ Option scheme
1346+basicAuthUnsafe username password =
1347+ customAuth
1348+ (pure . L.applyBasicAuth username password)
13341349
13351350-- | The 'Option' set basic proxy authentication header.
13361351--
13371352-- @since 1.1.0
1338−
1339−basicProxyAuth
1340− :: ByteString -- ^ Username
1341− -> ByteString -- ^ Password
1342− -> Option scheme -- ^ Auth 'Option'
1353+basicProxyAuth ::
1354+ -- | Username
1355+ ByteString ->
1356+ -- | Password
1357+ ByteString ->
1358+ -- | Auth 'Option'
1359+ Option scheme
13431360basicProxyAuth username password =
13441361 withRequest (L.applyBasicProxyAuth username password)
13451362
13461363-- | The 'Option' adds OAuth1 authentication.
13471364--
13481365-- @since 0.2.0
1349−
1350−oAuth1
1351− :: ByteString -- ^ Consumer token
1352− -> ByteString -- ^ Consumer secret
1353− -> ByteString -- ^ OAuth token
1354− -> ByteString -- ^ OAuth token secret
1355− -> Option scheme -- ^ Auth 'Option'
1366+oAuth1 ::
1367+ -- | Consumer token
1368+ ByteString ->
1369+ -- | Consumer secret
1370+ ByteString ->
1371+ -- | OAuth token
1372+ ByteString ->
1373+ -- | OAuth token secret
1374+ ByteString ->
1375+ -- | Auth 'Option'
1376+ Option scheme
13561377oAuth1 consumerToken consumerSecret token tokenSecret =
13571378 customAuth (OAuth.signOAuth app creds)
13581379 where
1359− app = OAuth.newOAuth
1360− { OAuth.oauthConsumerKey = consumerToken
1361− , OAuth.oauthConsumerSecret = consumerSecret }
1380+ app =
1381+ OAuth.newOAuth
1382+ { OAuth.oauthConsumerKey = consumerToken,
1383+ OAuth.oauthConsumerSecret = consumerSecret
1384+ }
13621385 creds = OAuth.newCredential token tokenSecret
13631386
13641387-- | The 'Option' adds an OAuth2 bearer token. This is treated by many
@@ -1369,12 +1392,14 @@ oAuth1 consumerToken consumerSecret token tokenSecret =
13691392-- > oAuth2Bearer token = header "Authorization" ("Bearer " <> token)
13701393--
13711394-- See also: <https://en.wikipedia.org/wiki/OAuth>.
1372−
1373−oAuth2Bearer
1374− :: ByteString -- ^ Token
1375− -> Option 'Https -- ^ Auth 'Option'
1376−oAuth2Bearer token = customAuth
1377− (pure . attachHeader "Authorization" ("Bearer " <> token))
1395+oAuth2Bearer ::
1396+ -- | Token
1397+ ByteString ->
1398+ -- | Auth 'Option'
1399+ Option 'Https
1400+oAuth2Bearer token =
1401+ customAuth
1402+ (pure . attachHeader "Authorization" ("Bearer " <> token))
13781403
13791404-- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems
13801405-- to be used only by GitHub). This will be treated by whatever services
@@ -1385,19 +1410,20 @@ oAuth2Bearer token = customAuth
13851410-- > oAuth2Token token = header "Authorization" ("token" <> token)
13861411--
13871412-- See also: <https://developer.github.com/v3/oauth#3-use-the-access-token-to-access-the-api>.
1388−
1389−oAuth2Token
1390− :: ByteString -- ^ Token
1391− -> Option 'Https -- ^ Auth 'Option'
1392−oAuth2Token token = customAuth
1393− (pure . attachHeader "Authorization" ("token " <> token))
1413+oAuth2Token ::
1414+ -- | Token
1415+ ByteString ->
1416+ -- | Auth 'Option'
1417+ Option 'Https
1418+oAuth2Token token =
1419+ customAuth
1420+ (pure . attachHeader "Authorization" ("token " <> token))
13941421
13951422-- | A helper to create custom authentication 'Option's. The given
13961423-- 'IO'-enabled request transformation is applied after all other
13971424-- modifications when constructing a request. Use wisely.
13981425--
13991426-- @since 1.1.0
1400−
14011427customAuth :: (L.Request -> IO L.Request) -> Option scheme
14021428customAuth = Option mempty . pure
14031429
@@ -1407,10 +1433,9 @@ customAuth = Option mempty . pure
14071433-- | Specify the port to connect to explicitly. Normally, 'Url' you use
14081434-- determines the default port: @80@ for HTTP and @443@ for HTTPS. This
14091435-- 'Option' allows to choose an arbitrary port overwriting the defaults.
1410−
14111436port :: Int -> Option scheme
14121437port n = withRequest $ \x ->
1413− x { L.port = n }
1438+ x {L.port = n}
14141439
14151440-- | This 'Option' controls whether gzipped data should be decompressed on
14161441-- the fly. By default everything except for @\"application\/x-tar\"@ is
@@ -1421,38 +1446,38 @@ port n = withRequest $ \x ->
14211446-- You can also choose to decompress everything like this:
14221447--
14231448-- > decompress (const True)
1424−
1425−decompress
1426− :: (ByteString -> Bool) -- ^ Predicate that is given MIME type, it
1427− -- returns 'True' when content should be decompressed on the fly.
1428− -> Option scheme
1449+decompress ::
1450+ -- | Predicate that is given MIME type, it
1451+ -- returns 'True' when content should be decompressed on the fly.
1452+ (ByteString -> Bool) ->
1453+ Option scheme
14291454decompress f = withRequest $ \x ->
1430− x { L.decompress = f }
1455+ x {L.decompress = f}
14311456
14321457-- | Specify the number of microseconds to wait for response. The default
14331458-- value is 30 seconds (defined in 'L.ManagerSettings' of connection
14341459-- 'L.Manager').
1435−
1436−responseTimeout
1437− :: Int -- ^ Number of microseconds to wait
1438− -> Option scheme
1460+responseTimeout ::
1461+ -- | Number of microseconds to wait
1462+ Int ->
1463+ Option scheme
14391464responseTimeout n = withRequest $ \x ->
1440− x { L.responseTimeout = LI.ResponseTimeoutMicro n }
1465+ x {L.responseTimeout = LI.ResponseTimeoutMicro n}
14411466
14421467-- | HTTP version to send to the server, the default is HTTP 1.1.
1443−
1444−httpVersion
1445− :: Int -- ^ Major version number
1446− -> Int -- ^ Minor version number
1447− -> Option scheme
1468+httpVersion ::
1469+ -- | Major version number
1470+ Int ->
1471+ -- | Minor version number
1472+ Int ->
1473+ Option scheme
14481474httpVersion major minor = withRequest $ \x ->
1449− x { L.requestVersion = Y.HttpVersion major minor }
1475+ x {L.requestVersion = Y.HttpVersion major minor}
14501476
14511477----------------------------------------------------------------------------
14521478-- Response interpretations
14531479
14541480-- | Make a request and ignore the body of the response.
1455−
14561481newtype IgnoreResponse = IgnoreResponse (L.Response ())
14571482
14581483instance HttpResponse IgnoreResponse where
@@ -1462,7 +1487,6 @@ instance HttpResponse IgnoreResponse where
14621487
14631488-- | Use this as the fourth argument of 'req' to specify that you want it to
14641489-- ignore the response body.
1465−
14661490ignoreResponse :: Proxy IgnoreResponse
14671491ignoreResponse = Proxy
14681492
@@ -1470,7 +1494,6 @@ ignoreResponse = Proxy
14701494-- 'handleHttpException' method of 'MonadHttp' instance corresponding to
14711495-- monad in which you use 'req' will determine what to do in the case when
14721496-- parsing fails (the 'JsonHttpException' constructor will be used).
1473−
14741497newtype JsonResponse a = JsonResponse (L.Response a)
14751498
14761499instance FromJSON a => HttpResponse (JsonResponse a) where
@@ -1479,19 +1502,17 @@ instance FromJSON a => HttpResponse (JsonResponse a) where
14791502 getHttpResponse r = do
14801503 chunks <- L.brConsume (L.responseBody r)
14811504 case A.eitherDecode (BL.fromChunks chunks) of
1482− Left e -> throwIO (JsonHttpException e)
1505+ Left e -> throwIO (JsonHttpException e)
14831506 Right x -> return $ JsonResponse (x <$ r)
14841507 acceptHeader Proxy = Just "application/json"
14851508
14861509-- | Use this as the fourth argument of 'req' to specify that you want it to
14871510-- return the 'JsonResponse' interpretation.
1488−
14891511jsonResponse :: Proxy (JsonResponse a)
14901512jsonResponse = Proxy
14911513
14921514-- | Make a request and interpret the body of the response as a strict
14931515-- 'ByteString'.
1494−
14951516newtype BsResponse = BsResponse (L.Response ByteString)
14961517
14971518instance HttpResponse BsResponse where
@@ -1503,13 +1524,11 @@ instance HttpResponse BsResponse where
15031524
15041525-- | Use this as the fourth argument of 'req' to specify that you want to
15051526-- interpret the response body as a strict 'ByteString'.
1506−
15071527bsResponse :: Proxy BsResponse
15081528bsResponse = Proxy
15091529
15101530-- | Make a request and interpret the body of the response as a lazy
15111531-- 'BL.ByteString'.
1512−
15131532newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
15141533
15151534instance HttpResponse LbsResponse where
@@ -1521,7 +1540,6 @@ instance HttpResponse LbsResponse where
15211540
15221541-- | Use this as the fourth argument of 'req' to specify that you want to
15231542-- interpret the response body as a lazy 'BL.ByteString'.
1524−
15251543lbsResponse :: Proxy LbsResponse
15261544lbsResponse = Proxy
15271545
@@ -1531,14 +1549,13 @@ lbsResponse = Proxy
15311549-- | Fetch beginning of response and return it together with new
15321550-- @'L.Response' 'L.BodyReader'@ that can be passed to 'getHttpResponse' and
15331551-- such.
1534−
1535−grabPreview
1536− :: Int
1537− -- ^ How many bytes to fetch
1538− -> L.Response L.BodyReader
1539− -- ^ Response with body reader inside
1540− -> IO (ByteString, L.Response L.BodyReader)
1541− -- ^ Preview 'ByteString' and new response with body reader inside
1552+grabPreview ::
1553+ -- | How many bytes to fetch
1554+ Int ->
1555+ -- | Response with body reader inside
1556+ L.Response L.BodyReader ->
1557+ -- | Preview 'ByteString' and new response with body reader inside
1558+ IO (ByteString, L.Response L.BodyReader)
15421559grabPreview nbytes r = do
15431560 let br = L.responseBody r
15441561 (target, leftover, done) <- brReadN br nbytes
@@ -1561,18 +1578,17 @@ grabPreview nbytes r = do
15611578 if done
15621579 then return B.empty
15631580 else br
1564− return (target, r { L.responseBody = br' })
1581+ return (target, r {L.responseBody = br'})
15651582
15661583-- | Consume N bytes from 'L.BodyReader', return the target chunk, the
15671584-- leftover (may be empty), and whether we're done consuming the body.
1568−
1569−brReadN
1570− :: L.BodyReader
1571− -- ^ Body reader to stream from
1572− -> Int
1573− -- ^ How many bytes to consume
1574− -> IO (ByteString, ByteString, Bool)
1575− -- ^ Target chunk, the leftover, whether we're done
1585+brReadN ::
1586+ -- | Body reader to stream from
1587+ L.BodyReader ->
1588+ -- | How many bytes to consume
1589+ Int ->
1590+ -- | Target chunk, the leftover, whether we're done
1591+ IO (ByteString, ByteString, Bool)
15761592brReadN br n = go 0 id id
15771593 where
15781594 go !tlen t l = do
@@ -1581,9 +1597,9 @@ brReadN br n = go 0 id id
15811597 then return (r t, r l, True)
15821598 else do
15831599 let (target, leftover) = B.splitAt (n - tlen) chunk
1584− tlen' = B.length target
1585− t' = t . (target:)
1586− l' = l . (leftover:)
1600+ tlen' = B.length target
1601+ t' = t . (target :)
1602+ l' = l . (leftover :)
15871603 if tlen + tlen' < n
15881604 then go (tlen + tlen') t' l'
15891605 else return (r t', r l', False)
@@ -1593,47 +1609,45 @@ brReadN br n = go 0 id id
15931609-- Inspecting a response
15941610
15951611-- | Get the response body.
1596−
1597−responseBody
1598− :: HttpResponse response
1599− => response
1600− -> HttpResponseBody response
1612+responseBody ::
1613+ HttpResponse response =>
1614+ response ->
1615+ HttpResponseBody response
16011616responseBody = L.responseBody . toVanillaResponse
16021617
16031618-- | Get the response status code.
1604−
1605−responseStatusCode
1606− :: HttpResponse response
1607− => response
1608− -> Int
1619+responseStatusCode ::
1620+ HttpResponse response =>
1621+ response ->
1622+ Int
16091623responseStatusCode =
16101624 Y.statusCode . L.responseStatus . toVanillaResponse
16111625
16121626-- | Get the response status message.
1613−
1614−responseStatusMessage
1615− :: HttpResponse response
1616− => response
1617− -> ByteString
1627+responseStatusMessage ::
1628+ HttpResponse response =>
1629+ response ->
1630+ ByteString
16181631responseStatusMessage =
16191632 Y.statusMessage . L.responseStatus . toVanillaResponse
16201633
16211634-- | Lookup a particular header from a response.
1622−
1623−responseHeader
1624− :: HttpResponse response
1625− => response -- ^ Response interpretation
1626− -> ByteString -- ^ Header to lookup
1627− -> Maybe ByteString -- ^ Header value if found
1635+responseHeader ::
1636+ HttpResponse response =>
1637+ -- | Response interpretation
1638+ response ->
1639+ -- | Header to lookup
1640+ ByteString ->
1641+ -- | Header value if found
1642+ Maybe ByteString
16281643responseHeader r h =
16291644 (lookup (CI.mk h) . L.responseHeaders . toVanillaResponse) r
16301645
16311646-- | Get the response 'L.CookieJar'.
1632−
1633−responseCookieJar
1634− :: HttpResponse response
1635− => response
1636− -> L.CookieJar
1647+responseCookieJar ::
1648+ HttpResponse response =>
1649+ response ->
1650+ L.CookieJar
16371651responseCookieJar = L.responseCookieJar . toVanillaResponse
16381652
16391653----------------------------------------------------------------------------
@@ -1647,16 +1661,12 @@ responseCookieJar = L.responseCookieJar . toVanillaResponse
16471661-- | A type class for response interpretations. It allows to describe how to
16481662-- consume response from a @'L.Response' 'L.BodyReader'@ and produce the
16491663-- final result that is to be returned to the user.
1650−
16511664class HttpResponse response where
1652−
16531665 -- | The associated type is the type of body that can be extracted from an
16541666 -- instance of 'HttpResponse'.
1655−
16561667 type HttpResponseBody response :: Type
16571668
16581669 -- | The method describes how to get the underlying 'L.Response' record.
1659−
16601670 toVanillaResponse :: response -> L.Response (HttpResponseBody response)
16611671
16621672 -- | This method describes how to consume response body and, more
@@ -1672,12 +1682,11 @@ class HttpResponse response where
16721682 --
16731683 -- __Note__: signature of this function was changed in the version
16741684 -- /1.0.0/.
1675−
1676− getHttpResponse
1677− :: L.Response L.BodyReader
1678− -- ^ Response with body reader inside
1679− -> IO response
1680− -- ^ The final result
1685+ getHttpResponse ::
1686+ -- | Response with body reader inside
1687+ L.Response L.BodyReader ->
1688+ -- | The final result
1689+ IO response
16811690
16821691 -- | The value of @\"Accept\"@ header. This is useful, for example, if a
16831692 -- website supports both @XML@ and @JSON@ responses, and decides what to
@@ -1687,7 +1696,6 @@ class HttpResponse response where
16871696 -- will take precedence.
16881697 --
16891698 -- @since 2.1.0
1690−
16911699 acceptHeader :: Proxy response -> Maybe ByteString
16921700 acceptHeader Proxy = Nothing
16931701
@@ -1701,15 +1709,12 @@ class HttpResponse response where
17011709-- request components easier using @('<>')@.
17021710--
17031711-- __Note__: this type class is not a part of the public API.
1704−
17051712class RequestComponent a where
1706−
17071713 -- | Get a function that takes a 'L.Request' and changes it somehow
17081714 -- returning another 'L.Request'. For example, the 'HttpMethod' instance
17091715 -- of 'RequestComponent' just overwrites method. The function is wrapped
17101716 -- in 'Endo' so it's easier to chain such “modifying applications”
17111717 -- together building bigger and bigger 'RequestComponent's.
1712−
17131718 getRequestMod :: a -> Endo L.Request
17141719
17151720-- | This wrapper is only used to attach a type-level tag to a given type.
@@ -1719,17 +1724,15 @@ class RequestComponent a where
17191724-- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides
17201725-- which instance to use (i.e. the constraints are taken into account later,
17211726-- when instance is already chosen).
1722−
17231727newtype Womb (tag :: Symbol) a = Womb a
17241728
17251729-- | Exceptions that this library throws.
1726−
17271730data HttpException
1728− = VanillaHttpException L.HttpException
1729− -- ^ A wrapper with an 'L.HttpException' from "Network.HTTP.Client"
1730− | JsonHttpException String
1731− -- ^ A wrapper with Aeson-produced 'String' describing why decoding
1731+ = -- | A wrapper with an 'L.HttpException' from "Network.HTTP.Client"
1732+ VanillaHttpException L.HttpException
1733+ | -- | A wrapper with Aeson-produced 'String' describing why decoding
17321734 -- failed
1735+ JsonHttpException String
17331736 deriving (Show, Typeable, Generic)
17341737
17351738instance Exception HttpException
@@ -1739,24 +1742,25 @@ instance Exception HttpException
17391742-- tags.
17401743--
17411744-- See also: 'HttpMethod' and 'HttpBody'.
1742−
17431745data CanHaveBody
1744− = CanHaveBody -- ^ Indeed can have a body
1745− | NoBody -- ^ Should not have a body
1746+ = -- | Indeed can have a body
1747+ CanHaveBody
1748+ | -- | Should not have a body
1749+ NoBody
17461750
17471751-- | A type-level tag that specifies URL scheme used (and thus if HTTPS is
17481752-- enabled). This is used to force TLS requirement for some authentication
17491753-- 'Option's.
1750−
17511754data Scheme
1752− = Http -- ^ HTTP
1753− | Https -- ^ HTTPS
1755+ = -- | HTTP
1756+ Http
1757+ | -- | HTTPS
1758+ Https
17541759 deriving (Eq, Ord, Show, Data, Typeable, Generic)
17551760
17561761----------------------------------------------------------------------------
17571762-- Constants
17581763
17591764-- | Max length of preview fragment of response body.
1760−
17611765bodyPreviewLength :: Num a => a
17621766bodyPreviewLength = 1024