{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      :  Network.HTTP.Req
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- The documentation below is structured in such a way that the most
-- important information is presented first: you learn how to do HTTP
-- requests, how to embed them in the monad you have, and then it gives you
-- details about less-common things you may want to know about. The
-- documentation is written with sufficient coverage of details and
-- examples, and it's designed to be a complete tutorial on its own.
--
-- === About the library
--
-- Req is an HTTP client library that attempts to be easy-to-use, type-safe,
-- and expandable.
--
-- “Easy-to-use” means that the library is designed to be beginner-friendly
-- so it's simple to add to your monad stack, intuitive to work with,
-- well-documented, and does not get in your way. Doing HTTP requests is a
-- common task and a Haskell library for this should be approachable and
-- clear to beginners, thus certain compromises were made. For example, one
-- cannot currently modify 'L.ManagerSettings' of the default manager
-- because the library always uses the same implicit global manager for
-- simplicity and maximal connection sharing. There is a way to use your own
-- manager with different settings, but it requires more typing.
--
-- “Type-safe” means that the library tries to eliminate certain classes of
-- errors. For example, we have correct-by-construction URLs; it is
-- guaranteed that the user does not send the request body when using
-- methods like GET or OPTIONS, and the amount of implicit assumptions is
-- minimized by making the user specify their intentions in an explicit
-- form. For example, it's not possible to avoid specifying the body or the
-- method of a request. Authentication methods that assume HTTPS force the
-- user to use HTTPS at the type level.
--
-- “Expandable” refers to the ability to create new components without
-- having to resort to hacking. For example, it's possible to define your
-- own HTTP methods, create new ways to construct the body of a request,
-- create new authorization options, perform a request in a different way,
-- and create your own methods to parse a response.
--
-- === Using with other libraries
--
--     * You won't need the low-level interface of @http-client@ most of the
--       time, but when you do, it's better to do a qualified import,
--       because @http-client@ has naming conflicts with @req@.
--     * For streaming of large request bodies see the companion package
--       @req-conduit@: <https://hackage.haskell.org/package/req-conduit>.
--
-- === Lightweight, no risk solution
--
-- The library uses the following mature packages under the hood to
-- guarantee you the best experience:
--
--     * <https://hackage.haskell.org/package/http-client>—low level HTTP
--       client used everywhere in Haskell.
--     * <https://hackage.haskell.org/package/http-client-tls>—TLS (HTTPS)
--       support for @http-client@.
--
-- It's important to note that since we leverage well-known libraries that
-- the whole Haskell ecosystem uses, there is no risk in using @req@. The
-- machinery for performing requests is the same as with @http-conduit@ and
-- @wreq@. The only difference is the API.
module Network.HTTP.Req
  ( -- * Making a request
    -- $making-a-request
    req,
    reqBr,
    reqCb,
    req',
    withReqManager,

    -- * Embedding requests in your monad
    -- $embedding-requests
    MonadHttp (..),
    HttpConfig (..),
    defaultHttpConfig,
    Req,
    runReq,

    -- * Request

    -- ** Method
    -- $method
    GET (..),
    POST (..),
    HEAD (..),
    PUT (..),
    DELETE (..),
    TRACE (..),
    CONNECT (..),
    OPTIONS (..),
    PATCH (..),
    HttpMethod (..),

    -- ** URL
    -- $url
    Url,
    http,
    https,
    (/~),
    (/:),
    useHttpURI,
    useHttpsURI,
    useURI,
    urlQ,
    renderUrl,

    -- ** Body
    -- $body
    NoReqBody (..),
    ReqBodyJson (..),
    ReqBodyFile (..),
    ReqBodyBs (..),
    ReqBodyLbs (..),
    ReqBodyUrlEnc (..),
    FormUrlEncodedParam,
    ReqBodyMultipart,
    reqBodyMultipart,
    HttpBody (..),
    ProvidesBody,
    HttpBodyAllowed,

    -- ** Optional parameters
    -- $optional-parameters
    Option,

    -- *** Query parameters
    -- $query-parameters
    (=:),
    queryFlag,
    formToQuery,
    QueryParam (..),

    -- *** Headers
    header,
    attachHeader,
    headerRedacted,

    -- *** Cookies
    -- $cookies
    cookieJar,

    -- *** Authentication
    -- $authentication
    basicAuth,
    basicAuthUnsafe,
    basicProxyAuth,
    oAuth1,
    oAuth2Bearer,
    oAuth2Token,
    customAuth,

    -- *** Other
    port,
    decompress,
    responseTimeout,
    httpVersion,

    -- * Response

    -- ** Response interpretations
    IgnoreResponse,
    ignoreResponse,
    JsonResponse,
    jsonResponse,
    BsResponse,
    bsResponse,
    LbsResponse,
    lbsResponse,

    -- ** Inspecting a response
    responseBody,
    responseStatusCode,
    responseStatusMessage,
    responseHeader,
    responseCookieJar,

    -- ** Defining your own interpretation
    -- $new-response-interpretation
    HttpResponse (..),

    -- * Other
    HttpException (..),
    isStatusCodeException,
    CanHaveBody (..),
    Scheme (..),
  )
where

import qualified Blaze.ByteString.Builder as BB
import Control.Applicative
import Control.Arrow (first, second)
import Control.Exception hiding (Handler (..), TypeError)
import Control.Monad (guard, void, (>=>))
import Control.Monad.Base
import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)
import Control.Monad.Trans.Accum (AccumT)
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Control
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Identity (IdentityT)
import Control.Monad.Trans.Maybe (MaybeT)
import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS
import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
import Control.Monad.Trans.Select (SelectT)
import qualified Control.Monad.Trans.State.Lazy as State.Lazy
import qualified Control.Monad.Trans.State.Strict as State.Strict
import qualified Control.Monad.Trans.Writer.CPS as Writer.CPS
import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
import Control.Retry
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as A
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import Data.Data (Data)
import Data.Function (on)
import Data.IORef
import Data.Kind (Constraint, Type)
import Data.List (foldl', nubBy)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Data.Proxy
import Data.Semigroup (Endo (..))
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable (Typeable, cast)
import GHC.Generics
import GHC.TypeLits
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Quote as TH
import qualified Language.Haskell.TH.Syntax as TH
import qualified Network.Connection as NC
import qualified Network.HTTP.Client as L
import qualified Network.HTTP.Client.Internal as LI
import qualified Network.HTTP.Client.MultipartFormData as LM
import qualified Network.HTTP.Client.TLS as L
import qualified Network.HTTP.Types as Y
import System.IO.Unsafe (unsafePerformIO)
import Text.URI (URI)
import qualified Text.URI as URI
import qualified Text.URI.QQ as QQ
import qualified Web.Authenticate.OAuth as OAuth
import Web.FormUrlEncoded (FromForm (..), ToForm (..))
import qualified Web.FormUrlEncoded as Form
import Web.HttpApiData (ToHttpApiData (..))

----------------------------------------------------------------------------
-- Making a request

-- $making-a-request
--
-- To make an HTTP request you normally need only one function: 'req'.

-- | Make an HTTP request. The function takes 5 arguments, 4 of which
-- specify required parameters and the final 'Option' argument is a
-- collection of optional parameters.
--
-- Let's go through all the arguments first: @req method url body response
-- options@.
--
-- @method@ is an HTTP method such as 'GET' or 'POST'. The documentation has
-- a dedicated section about HTTP methods below.
--
-- @url@ is a 'Url' that describes location of resource you want to interact
-- with.
--
-- @body@ is a body option such as 'NoReqBody' or 'ReqBodyJson'. The
-- tutorial has a section about HTTP bodies, but usage is very
-- straightforward and should be clear from the examples.
--
-- @response@ is a type hint how to make and interpret response of an HTTP
-- request. Out-of-the-box it can be the following:
--
--     * 'ignoreResponse'
--     * 'jsonResponse'
--     * 'bsResponse' (to get a strict 'ByteString')
--     * 'lbsResponse' (to get a lazy 'BL.ByteString')
--
-- Finally, @options@ is a 'Monoid' that holds a composite 'Option' for all
-- other optional settings like query parameters, headers, non-standard port
-- number, etc. There are quite a few things you can put there, see the
-- corresponding section in the documentation. If you don't need anything at
-- all, pass 'mempty'.
--
-- __Note__ that if you use 'req' to do all your requests, connection
-- sharing and reuse is done for you automatically.
--
-- See the examples below to get on the speed quickly.
--
-- ==== __Examples__
--
-- First, this is a piece of boilerplate that should be in place before you
-- try the examples:
--
-- > {-# LANGUAGE DeriveGeneric     #-}
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > module Main (main) where
-- >
-- > import Control.Monad
-- > import Control.Monad.IO.Class
-- > import Data.Aeson
-- > import Data.Maybe (fromJust)
-- > import Data.Monoid ((<>))
-- > import Data.Text (Text)
-- > import GHC.Generics
-- > import Network.HTTP.Req
-- > import qualified Data.ByteString.Char8 as B
-- > import qualified Text.URI as URI
--
-- We will be making requests against the <https://httpbin.org> service.
--
-- Make a GET request, grab 5 random bytes:
--
-- > main :: IO ()
-- > main = runReq defaultHttpConfig $ do
-- >   let n :: Int
-- >       n = 5
-- >   bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse mempty
-- >   liftIO $ B.putStrLn (responseBody bs)
--
-- The same, but now we use a query parameter named @\"seed\"@ to control
-- seed of the generator:
--
-- > main :: IO ()
-- > main = runReq defaultHttpConfig $ do
-- >   let n, seed :: Int
-- >       n    = 5
-- >       seed = 100
-- >   bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse $
-- >     "seed" =: seed
-- >   liftIO $ B.putStrLn (responseBody bs)
--
-- POST JSON data and get some info about the POST request:
--
-- > data MyData = MyData
-- >   { size  :: Int
-- >   , color :: Text
-- >   } deriving (Show, Generic)
-- >
-- > instance ToJSON MyData
-- > instance FromJSON MyData
-- >
-- > main :: IO ()
-- > main = runReq defaultHttpConfig $ do
-- >   let myData = MyData
-- >         { size  = 6
-- >         , color = "Green" }
-- >   v <- req POST (https "httpbin.org" /: "post") (ReqBodyJson myData) jsonResponse mempty
-- >   liftIO $ print (responseBody v :: Value)
--
-- Sending URL-encoded body:
--
-- > main :: IO ()
-- > main = runReq defaultHttpConfig $ do
-- >   let params =
-- >         "foo" =: ("bar" :: Text) <>
-- >         queryFlag "baz"
-- >   response <- req POST (https "httpbin.org" /: "post") (ReqBodyUrlEnc params) jsonResponse mempty
-- >   liftIO $ print (responseBody response :: Value)
--
-- Using various optional parameters and URL that is not known in advance:
--
-- > main :: IO ()
-- > main = runReq defaultHttpConfig $ do
-- >   -- This is an example of what to do when URL is given dynamically. Of
-- >   -- course in a real application you may not want to use 'fromJust'.
-- >   uri <- URI.mkURI "https://httpbin.org/get?foo=bar"
-- >   let (url, options) = fromJust (useHttpsURI uri)
-- >   response <- req GET url NoReqBody jsonResponse $
-- >     "from" =: (15 :: Int)           <>
-- >     "to"   =: (67 :: Int)           <>
-- >     basicAuth "username" "password" <>
-- >     options                         <> -- contains the ?foo=bar part
-- >     port 443 -- here you can put any port of course
-- >   liftIO $ print (responseBody response :: Value)
req ::
  ( MonadHttp m,
    HttpMethod method,
    HttpBody body,
    HttpResponse response,
    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
  ) =>
  -- | HTTP method
  method ->
  -- | 'Url'—location of resource
  Url scheme ->
  -- | Body of the request
  body ->
  -- | A hint how to interpret response
  Proxy response ->
  -- | Collection of optional parameters
  Option scheme ->
  -- | Response
  m response
req :: method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req method
method Url scheme
url body
body Proxy response
responseProxy Option scheme
options =
  method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> (Request -> m Request)
-> m response
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> (Request -> m Request)
-> m response
reqCb method
method Url scheme
url body
body Proxy response
responseProxy Option scheme
options Request -> m Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | A version of 'req' that does not use one of the predefined instances of
-- 'HttpResponse' but instead allows the user to consume @'L.Response'
-- 'L.BodyReader'@ manually, in a custom way.
--
-- @since 1.0.0
reqBr ::
  ( MonadHttp m,
    HttpMethod method,
    HttpBody body,
    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
  ) =>
  -- | HTTP method
  method ->
  -- | 'Url'—location of resource
  Url scheme ->
  -- | Body of the request
  body ->
  -- | Collection of optional parameters
  Option scheme ->
  -- | How to consume response
  (L.Response L.BodyReader -> IO a) ->
  -- | Result
  m a
reqBr :: method
-> Url scheme
-> body
-> Option scheme
-> (Response BodyReader -> IO a)
-> m a
reqBr method
method Url scheme
url body
body Option scheme
options Response BodyReader -> IO a
consume =
  method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m a)
-> m a
forall (m :: * -> *) method body (scheme :: Scheme) a.
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m a)
-> m a
req' method
method Url scheme
url body
body Option scheme
options ((Response BodyReader -> IO a) -> Request -> Manager -> m a
forall (m :: * -> *) b.
MonadHttp m =>
(Response BodyReader -> IO b) -> Request -> Manager -> m b
reqHandler Response BodyReader -> IO a
consume)

-- | A version of 'req' that takes a callback to modify the 'L.Request', but
-- otherwise performs the request identically.
--
-- @since 3.7.0
reqCb ::
  ( MonadHttp m,
    HttpMethod method,
    HttpBody body,
    HttpResponse response,
    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
  ) =>
  -- | HTTP method
  method ->
  -- | 'Url'—location of resource
  Url scheme ->
  -- | Body of the request
  body ->
  -- | A hint how to interpret response
  Proxy response ->
  -- | Collection of optional parameters
  Option scheme ->
  -- | Callback to modify the request
  (L.Request -> m L.Request) ->
  -- | Response
  m response
reqCb :: method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> (Request -> m Request)
-> m response
reqCb method
method Url scheme
url body
body Proxy response
responseProxy Option scheme
options Request -> m Request
adjustRequest =
  method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m response)
-> m response
forall (m :: * -> *) method body (scheme :: Scheme) a.
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m a)
-> m a
req' method
method Url scheme
url body
body (Option scheme
options Option scheme -> Option scheme -> Option scheme
forall a. Semigroup a => a -> a -> a
<> Option scheme
extraOptions) ((Request -> Manager -> m response) -> m response)
-> (Request -> Manager -> m response) -> m response
forall a b. (a -> b) -> a -> b
$ \Request
request Manager
manager -> do
    Request
request' <- Request -> m Request
adjustRequest Request
request
    (Response BodyReader -> IO response)
-> Request -> Manager -> m response
forall (m :: * -> *) b.
MonadHttp m =>
(Response BodyReader -> IO b) -> Request -> Manager -> m b
reqHandler Response BodyReader -> IO response
forall response.
HttpResponse response =>
Response BodyReader -> IO response
getHttpResponse Request
request' Manager
manager
  where
    extraOptions :: Option scheme
extraOptions =
      case Proxy response -> Maybe ByteString
forall response.
HttpResponse response =>
Proxy response -> Maybe ByteString
acceptHeader Proxy response
responseProxy of
        Maybe ByteString
Nothing -> Option scheme
forall a. Monoid a => a
mempty
        Just ByteString
accept -> ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Accept" ByteString
accept

-- | The default handler function that the higher-level request functions
-- pass to 'req''. Internal function.
--
-- @since 3.7.0
reqHandler ::
  MonadHttp m =>
  -- | How to get final result from a 'L.Response'
  (L.Response L.BodyReader -> IO b) ->
  -- | 'L.Request' to perform
  L.Request ->
  -- | 'L.Manager' to use
  L.Manager ->
  m b
reqHandler :: (Response BodyReader -> IO b) -> Request -> Manager -> m b
reqHandler Response BodyReader -> IO b
consume Request
request Manager
manager = do
  HttpConfig {Int
Maybe Proxy
Maybe Manager
RetryPolicyM IO
RetryStatus -> SomeException -> Bool
forall a. Num a => a
forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
forall b. RetryStatus -> Response b -> Bool
httpConfigBodyPreviewLength :: HttpConfig -> forall a. Num a => a
httpConfigRetryJudgeException :: HttpConfig -> RetryStatus -> SomeException -> Bool
httpConfigRetryJudge :: HttpConfig -> forall b. RetryStatus -> Response b -> Bool
httpConfigRetryPolicy :: HttpConfig -> RetryPolicyM IO
httpConfigCheckResponse :: HttpConfig
-> forall b.
   Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigAltManager :: HttpConfig -> Maybe Manager
httpConfigRedirectCount :: HttpConfig -> Int
httpConfigProxy :: HttpConfig -> Maybe Proxy
httpConfigBodyPreviewLength :: forall a. Num a => a
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigAltManager :: Maybe Manager
httpConfigRedirectCount :: Int
httpConfigProxy :: Maybe Proxy
..} <- m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
  let wrapVanilla :: IO a -> IO a
wrapVanilla = (HttpException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (HttpException -> IO a
forall e a. Exception e => e -> IO a
throwIO (HttpException -> IO a)
-> (HttpException -> HttpException) -> HttpException -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> HttpException
VanillaHttpException)
      wrapExc :: IO b -> IO b
wrapExc = (HttpExceptionContentWrapper -> IO b) -> IO b -> IO b
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (HttpException -> IO b
forall e a. Exception e => e -> IO a
throwIO (HttpException -> IO b)
-> (HttpExceptionContentWrapper -> HttpException)
-> HttpExceptionContentWrapper
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> HttpExceptionContentWrapper -> HttpException
LI.toHttpException Request
request)
      withRRef :: (IORef (Maybe (Response a)) -> IO c) -> IO c
withRRef =
        IO (IORef (Maybe (Response a)))
-> (IORef (Maybe (Response a)) -> IO ())
-> (IORef (Maybe (Response a)) -> IO c)
-> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
          (Maybe (Response a) -> IO (IORef (Maybe (Response a)))
forall a. a -> IO (IORef a)
newIORef Maybe (Response a)
forall a. Maybe a
Nothing)
          (IORef (Maybe (Response a)) -> IO (Maybe (Response a))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (Response a)) -> IO (Maybe (Response a)))
-> (Maybe (Response a) -> IO ())
-> IORef (Maybe (Response a))
-> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Response a -> IO ()) -> Maybe (Response a) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Response a -> IO ()
forall a. Response a -> IO ()
L.responseClose)
  (IO (Either HttpException b) -> m (Either HttpException b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException b) -> m (Either HttpException b))
-> (IO b -> IO (Either HttpException b))
-> IO b
-> m (Either HttpException b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO (Either HttpException b)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO b -> IO (Either HttpException b))
-> (IO b -> IO b) -> IO b -> IO (Either HttpException b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO b
forall a. IO a -> IO a
wrapVanilla (IO b -> IO b) -> (IO b -> IO b) -> IO b -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO b
wrapExc)
    ( (IORef (Maybe (Response BodyReader)) -> IO b) -> IO b
forall a c. (IORef (Maybe (Response a)) -> IO c) -> IO c
withRRef ((IORef (Maybe (Response BodyReader)) -> IO b) -> IO b)
-> (IORef (Maybe (Response BodyReader)) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \IORef (Maybe (Response BodyReader))
rref -> do
        let openResponse :: IO (Response BodyReader)
openResponse = IO (Response BodyReader) -> IO (Response BodyReader)
forall a. IO a -> IO a
mask_ (IO (Response BodyReader) -> IO (Response BodyReader))
-> IO (Response BodyReader) -> IO (Response BodyReader)
forall a b. (a -> b) -> a -> b
$ do
              Maybe (Response BodyReader)
r <- IORef (Maybe (Response BodyReader))
-> IO (Maybe (Response BodyReader))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Response BodyReader))
rref
              (Response BodyReader -> IO ())
-> Maybe (Response BodyReader) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Response BodyReader -> IO ()
forall a. Response a -> IO ()
L.responseClose Maybe (Response BodyReader)
r
              Response BodyReader
r' <- Request -> Manager -> IO (Response BodyReader)
L.responseOpen Request
request Manager
manager
              IORef (Maybe (Response BodyReader))
-> Maybe (Response BodyReader) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Response BodyReader))
rref (Response BodyReader -> Maybe (Response BodyReader)
forall a. a -> Maybe a
Just Response BodyReader
r')
              Response BodyReader -> IO (Response BodyReader)
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
r'
            exceptionRetryPolicies :: [RetryStatus -> Handler IO Bool]
exceptionRetryPolicies =
              [RetryStatus -> Handler IO Bool]
forall (m :: * -> *). MonadIO m => [RetryStatus -> Handler m Bool]
skipAsyncExceptions
                [RetryStatus -> Handler IO Bool]
-> [RetryStatus -> Handler IO Bool]
-> [RetryStatus -> Handler IO Bool]
forall a. [a] -> [a] -> [a]
++ [ \RetryStatus
retryStatus -> (SomeException -> IO Bool) -> Handler IO Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((SomeException -> IO Bool) -> Handler IO Bool)
-> (SomeException -> IO Bool) -> Handler IO Bool
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
                       Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ RetryStatus -> SomeException -> Bool
httpConfigRetryJudgeException RetryStatus
retryStatus SomeException
e
                   ]
        Response BodyReader
r <-
          RetryPolicyM IO
-> (RetryStatus -> Response BodyReader -> IO Bool)
-> (RetryStatus -> IO (Response BodyReader))
-> IO (Response BodyReader)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying
            RetryPolicyM IO
httpConfigRetryPolicy
            (\RetryStatus
retryStatus Response BodyReader
r -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ RetryStatus -> Response BodyReader -> Bool
forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge RetryStatus
retryStatus Response BodyReader
r)
            ( IO (Response BodyReader) -> RetryStatus -> IO (Response BodyReader)
forall a b. a -> b -> a
const
                ( RetryPolicyM IO
-> [RetryStatus -> Handler IO Bool]
-> (RetryStatus -> IO (Response BodyReader))
-> IO (Response BodyReader)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering
                    RetryPolicyM IO
httpConfigRetryPolicy
                    [RetryStatus -> Handler IO Bool]
exceptionRetryPolicies
                    (IO (Response BodyReader) -> RetryStatus -> IO (Response BodyReader)
forall a b. a -> b -> a
const IO (Response BodyReader)
openResponse)
                )
            )
        (ByteString
preview, Response BodyReader
r') <- Int -> Response BodyReader -> IO (ByteString, Response BodyReader)
grabPreview Int
forall a. Num a => a
httpConfigBodyPreviewLength Response BodyReader
r
        (HttpExceptionContent -> IO Any)
-> Maybe HttpExceptionContent -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HttpExceptionContent -> IO Any
forall a. HttpExceptionContent -> IO a
LI.throwHttp (Request
-> Response BodyReader -> ByteString -> Maybe HttpExceptionContent
forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse Request
request Response BodyReader
r' ByteString
preview)
        Response BodyReader -> IO b
consume Response BodyReader
r'
    )
    m (Either HttpException b)
-> (Either HttpException b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HttpException -> m b)
-> (b -> m b) -> Either HttpException b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> m b
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Mostly like 'req' with respect to its arguments, but accepts a callback
-- that allows to perform a request in arbitrary fashion.
--
-- This function /does not/ perform handling\/wrapping exceptions, checking
-- response (with 'httpConfigCheckResponse'), and retrying. It only prepares
-- 'L.Request' and allows you to use it.
--
-- @since 0.3.0
req' ::
  forall m method body scheme a.
  ( MonadHttp m,
    HttpMethod method,
    HttpBody body,
    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
  ) =>
  -- | HTTP method
  method ->
  -- | 'Url'—location of resource
  Url scheme ->
  -- | Body of the request
  body ->
  -- | Collection of optional parameters
  Option scheme ->
  -- | How to perform request
  (L.Request -> L.Manager -> m a) ->
  -- | Result
  m a
req' :: method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m a)
-> m a
req' method
method Url scheme
url body
body Option scheme
options Request -> Manager -> m a
m = do
  HttpConfig
config <- m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
  let -- NOTE First appearance of any given header wins. This allows to
      -- “overwrite” headers when we construct a request by cons-ing.
      nubHeaders :: Endo Request
nubHeaders = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
        Request
x {requestHeaders :: RequestHeaders
L.requestHeaders = ((HeaderName, ByteString) -> (HeaderName, ByteString) -> Bool)
-> RequestHeaders -> RequestHeaders
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (HeaderName -> HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) (Request -> RequestHeaders
L.requestHeaders Request
x)}
      request' :: Request
request' =
        (Endo Request -> Request -> Request)
-> Request -> Endo Request -> Request
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo Request -> Request -> Request
forall a. Endo a -> a -> a
appEndo Request
L.defaultRequest (Endo Request -> Request) -> Endo Request -> Request
forall a b. (a -> b) -> a -> b
$
          -- NOTE The order of 'mappend's matters, here method is overwritten
          -- first and 'options' take effect last. In particular, this means
          -- that 'options' can overwrite things set by other request
          -- components, which is useful for setting port number,
          -- "Content-Type" header, etc.
          Endo Request
nubHeaders
            Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> Option scheme -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod Option scheme
options
            Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> HttpConfig -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod HttpConfig
config
            Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> Tagged "body" body -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod (body -> Tagged "body" body
forall (tag :: Symbol) a. a -> Tagged tag a
Tagged body
body :: Tagged "body" body)
            Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> Url scheme -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod Url scheme
url
            Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> Tagged "method" method -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod (method -> Tagged "method" method
forall (tag :: Symbol) a. a -> Tagged tag a
Tagged method
method :: Tagged "method" method)
  Request
request <- Option scheme -> Request -> m Request
forall (m :: * -> *) (scheme :: Scheme).
MonadIO m =>
Option scheme -> Request -> m Request
finalizeRequest Option scheme
options Request
request'
  (Manager -> m a) -> m a
forall (m :: * -> *) a. MonadIO m => (Manager -> m a) -> m a
withReqManager (Request -> Manager -> m a
m Request
request)

-- | Perform an action using the global implicit 'L.Manager' that the rest
-- of the library uses. This allows to reuse connections that the
-- 'L.Manager' controls.
withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
withReqManager :: (Manager -> m a) -> m a
withReqManager Manager -> m a
m = IO Manager -> m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Manager -> IO Manager
forall a. IORef a -> IO a
readIORef IORef Manager
globalManager) m Manager -> (Manager -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> m a
m

-- | The global 'L.Manager' that 'req' uses. Here we just go with the
-- default settings, so users don't need to deal with this manager stuff at
-- all, but when we create a request, instance 'HttpConfig' can affect the
-- default settings via 'getHttpConfig'.
--
-- A note about safety, in case 'unsafePerformIO' looks suspicious to you.
-- The value of 'globalManager' is named and lives on top level. This means
-- it will be shared, i.e. computed only once on the first use of the
-- manager. From that moment on the 'IORef' will be just reused—exactly the
-- behavior we want here in order to maximize connection sharing. GHC could
-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
globalManager :: IORef L.Manager
globalManager :: IORef Manager
globalManager = IO (IORef Manager) -> IORef Manager
forall a. IO a -> a
unsafePerformIO (IO (IORef Manager) -> IORef Manager)
-> IO (IORef Manager) -> IORef Manager
forall a b. (a -> b) -> a -> b
$ do
  ConnectionContext
context <- IO ConnectionContext
NC.initConnectionContext
  let settings :: ManagerSettings
settings =
        Maybe ConnectionContext
-> TLSSettings -> Maybe SockSettings -> ManagerSettings
L.mkManagerSettingsContext
          (ConnectionContext -> Maybe ConnectionContext
forall a. a -> Maybe a
Just ConnectionContext
context)
          (Bool -> Bool -> Bool -> TLSSettings
NC.TLSSettingsSimple Bool
False Bool
False Bool
False)
          Maybe SockSettings
forall a. Maybe a
Nothing
  Manager
manager <- ManagerSettings -> IO Manager
L.newManager ManagerSettings
settings
  Manager -> IO (IORef Manager)
forall a. a -> IO (IORef a)
newIORef Manager
manager
{-# NOINLINE globalManager #-}

----------------------------------------------------------------------------
-- Embedding requests in your monad

-- $embedding-requests
--
-- To use 'req' in your monad, all you need to do is to make the monad an
-- instance of the 'MonadHttp' type class.
--
-- When writing a library, keep your API polymorphic in terms of
-- 'MonadHttp', only define instance of 'MonadHttp' in final application.
-- Another option is to use a @newtype@-wrapped monad stack and define
-- 'MonadHttp' for it. As of the version /0.4.0/, the 'Req' monad that
-- follows this strategy is provided out-of-the-box (see below).

-- | A type class for monads that support performing HTTP requests.
-- Typically, you only need to define the 'handleHttpException' method
-- unless you want to tweak 'HttpConfig'.
class MonadIO m => MonadHttp m where
  -- | This method describes how to deal with 'HttpException' that was
  -- caught by the library. One option is to re-throw it if you are OK with
  -- exceptions, but if you prefer working with something like
  -- 'Control.Monad.Except.MonadError', this is the right place to pass it to
  -- 'Control.Monad.Except.throwError'.
  handleHttpException :: HttpException -> m a

  -- | Return the 'HttpConfig' to be used when performing HTTP requests.
  -- Default implementation returns its 'def' value, which is described in
  -- the documentation for the type. Common usage pattern with manually
  -- defined 'getHttpConfig' is to return some hard-coded value, or a value
  -- extracted from 'Control.Monad.Reader.MonadReader' if a more flexible
  -- approach to configuration is desirable.
  getHttpConfig :: m HttpConfig
  getHttpConfig = HttpConfig -> m HttpConfig
forall (m :: * -> *) a. Monad m => a -> m a
return HttpConfig
defaultHttpConfig

-- | 'HttpConfig' contains settings to be used when making HTTP requests.
data HttpConfig = HttpConfig
  { -- | Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
    -- environment variables are respected, this setting overwrites them.
    -- Default value: 'Nothing'.
    HttpConfig -> Maybe Proxy
httpConfigProxy :: Maybe L.Proxy,
    -- | How many redirects to follow when getting a resource. Default
    -- value: 10.
    HttpConfig -> Int
httpConfigRedirectCount :: Int,
    -- | Alternative 'L.Manager' to use. 'Nothing' (default value) means
    -- that the default implicit manager will be used (that's what you want
    -- in 99% of cases).
    HttpConfig -> Maybe Manager
httpConfigAltManager :: Maybe L.Manager,
    -- | Function to check the response immediately after receiving the
    -- status and headers, before streaming of response body. The third
    -- argument is the beginning of response body (typically first 1024
    -- bytes). This is used for throwing exceptions on non-success status
    -- codes by default (set to @\\_ _ _ -> Nothing@ if this behavior is not
    -- desirable).
    --
    -- When the value this function returns is 'Nothing', nothing will
    -- happen. When it there is 'L.HttpExceptionContent' inside 'Just', it
    -- will be thrown.
    --
    -- Throwing is better then just returning a request with non-2xx status
    -- code because in that case something is wrong and we need a way to
    -- short-cut execution (also remember that Req retries automatically on
    -- request timeouts and such, so when your request fails, it's certainly
    -- something exceptional). The thrown exception is caught by the library
    -- though and is available in 'handleHttpException'.
    --
    -- __Note__: signature of this function was changed in the version
    -- /1.0.0/.
    --
    -- @since 0.3.0
    HttpConfig
-> forall b.
   Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse ::
      forall b.
      L.Request ->
      L.Response b ->
      ByteString ->
      Maybe L.HttpExceptionContent,
    -- | The retry policy to use for request retrying. By default 'def' is
    -- used (see 'RetryPolicyM').
    --
    -- __Note__: signature of this function was changed to disallow 'IO' in
    -- version /1.0.0/ and then changed back to its current form in /3.1.0/.
    --
    -- @since 0.3.0
    HttpConfig -> RetryPolicyM IO
httpConfigRetryPolicy :: RetryPolicyM IO,
    -- | The function is used to decide whether to retry a request. 'True'
    -- means that the request should be retried.
    --
    -- __Note__: signature of this function was changed in the version
    -- /1.0.0/.
    --
    -- @since 0.3.0
    HttpConfig -> forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool,
    -- | Similar to 'httpConfigRetryJudge', but is used to decide when to
    -- retry requests that resulted in an exception. By default it retries
    -- on response timeout and connection timeout (changed in version
    -- /3.8.0/).
    --
    -- @since 3.4.0
    HttpConfig -> RetryStatus -> SomeException -> Bool
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool,
    -- | Max length of preview fragment of response body.
    --
    -- @since 3.6.0
    HttpConfig -> forall a. Num a => a
httpConfigBodyPreviewLength :: forall a. Num a => a
  }
  deriving (Typeable)

-- | The default value of 'HttpConfig'.
--
-- @since 2.0.0
defaultHttpConfig :: HttpConfig
defaultHttpConfig :: HttpConfig
defaultHttpConfig =
  HttpConfig :: Maybe Proxy
-> Int
-> Maybe Manager
-> (forall b.
    Request -> Response b -> ByteString -> Maybe HttpExceptionContent)
-> RetryPolicyM IO
-> (forall b. RetryStatus -> Response b -> Bool)
-> (RetryStatus -> SomeException -> Bool)
-> (forall a. Num a => a)
-> HttpConfig
HttpConfig
    { httpConfigProxy :: Maybe Proxy
httpConfigProxy = Maybe Proxy
forall a. Maybe a
Nothing,
      httpConfigRedirectCount :: Int
httpConfigRedirectCount = Int
10,
      httpConfigAltManager :: Maybe Manager
httpConfigAltManager = Maybe Manager
forall a. Maybe a
Nothing,
      httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse = \Request
_ Response b
response ByteString
preview ->
        let scode :: Int
scode = Response b -> Int
forall body. Response body -> Int
statusCode Response b
response
         in if Int
200 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
scode Bool -> Bool -> Bool
&& Int
scode Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300
              then Maybe HttpExceptionContent
forall a. Maybe a
Nothing
              else HttpExceptionContent -> Maybe HttpExceptionContent
forall a. a -> Maybe a
Just (Response () -> ByteString -> HttpExceptionContent
L.StatusCodeException (Response b -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response b
response) ByteString
preview),
      httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigRetryPolicy = RetryPolicyM IO
forall (m :: * -> *). Monad m => RetryPolicyM m
retryPolicyDefault,
      httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge = \RetryStatus
_ Response b
response ->
        Response b -> Int
forall body. Response body -> Int
statusCode Response b
response
          Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Int
408, -- Request timeout
                   Int
504, -- Gateway timeout
                   Int
524, -- A timeout occurred
                   Int
598, -- (Informal convention) Network read timeout error
                   Int
599 -- (Informal convention) Network connect timeout error
                 ],
      httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool
httpConfigRetryJudgeException = \RetryStatus
_ SomeException
e ->
        case SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
          Just (L.HttpExceptionRequest Request
_ HttpExceptionContent
c) ->
            case HttpExceptionContent
c of
              HttpExceptionContent
L.ResponseTimeout -> Bool
True
              HttpExceptionContent
L.ConnectionTimeout -> Bool
True
              HttpExceptionContent
_ -> Bool
False
          Maybe HttpException
_ -> Bool
False,
      httpConfigBodyPreviewLength :: forall a. Num a => a
httpConfigBodyPreviewLength = a
forall a. Num a => a
1024
    }
  where
    statusCode :: Response body -> Int
statusCode = Status -> Int
Y.statusCode (Status -> Int)
-> (Response body -> Status) -> Response body -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response body -> Status
forall body. Response body -> Status
L.responseStatus

instance RequestComponent HttpConfig where
  getRequestMod :: HttpConfig -> Endo Request
getRequestMod HttpConfig {Int
Maybe Proxy
Maybe Manager
RetryPolicyM IO
RetryStatus -> SomeException -> Bool
forall a. Num a => a
forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
forall b. RetryStatus -> Response b -> Bool
httpConfigBodyPreviewLength :: forall a. Num a => a
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigAltManager :: Maybe Manager
httpConfigRedirectCount :: Int
httpConfigProxy :: Maybe Proxy
httpConfigBodyPreviewLength :: HttpConfig -> forall a. Num a => a
httpConfigRetryJudgeException :: HttpConfig -> RetryStatus -> SomeException -> Bool
httpConfigRetryJudge :: HttpConfig -> forall b. RetryStatus -> Response b -> Bool
httpConfigRetryPolicy :: HttpConfig -> RetryPolicyM IO
httpConfigCheckResponse :: HttpConfig
-> forall b.
   Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigAltManager :: HttpConfig -> Maybe Manager
httpConfigRedirectCount :: HttpConfig -> Int
httpConfigProxy :: HttpConfig -> Maybe Proxy
..} = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
    Request
x
      { proxy :: Maybe Proxy
L.proxy = Maybe Proxy
httpConfigProxy,
        redirectCount :: Int
L.redirectCount = Int
httpConfigRedirectCount,
        requestManagerOverride :: Maybe Manager
LI.requestManagerOverride = Maybe Manager
httpConfigAltManager
      }

-- | A monad that allows us to run 'req' in any 'IO'-enabled monad without
-- having to define new instances.
--
-- @since 0.4.0
newtype Req a = Req (ReaderT HttpConfig IO a)
  deriving
    ( a -> Req b -> Req a
(a -> b) -> Req a -> Req b
(forall a b. (a -> b) -> Req a -> Req b)
-> (forall a b. a -> Req b -> Req a) -> Functor Req
forall a b. a -> Req b -> Req a
forall a b. (a -> b) -> Req a -> Req b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Req b -> Req a
$c<$ :: forall a b. a -> Req b -> Req a
fmap :: (a -> b) -> Req a -> Req b
$cfmap :: forall a b. (a -> b) -> Req a -> Req b
Functor,
      Functor Req
a -> Req a
Functor Req
-> (forall a. a -> Req a)
-> (forall a b. Req (a -> b) -> Req a -> Req b)
-> (forall a b c. (a -> b -> c) -> Req a -> Req b -> Req c)
-> (forall a b. Req a -> Req b -> Req b)
-> (forall a b. Req a -> Req b -> Req a)
-> Applicative Req
Req a -> Req b -> Req b
Req a -> Req b -> Req a
Req (a -> b) -> Req a -> Req b
(a -> b -> c) -> Req a -> Req b -> Req c
forall a. a -> Req a
forall a b. Req a -> Req b -> Req a
forall a b. Req a -> Req b -> Req b
forall a b. Req (a -> b) -> Req a -> Req b
forall a b c. (a -> b -> c) -> Req a -> Req b -> Req c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Req a -> Req b -> Req a
$c<* :: forall a b. Req a -> Req b -> Req a
*> :: Req a -> Req b -> Req b
$c*> :: forall a b. Req a -> Req b -> Req b
liftA2 :: (a -> b -> c) -> Req a -> Req b -> Req c
$cliftA2 :: forall a b c. (a -> b -> c) -> Req a -> Req b -> Req c
<*> :: Req (a -> b) -> Req a -> Req b
$c<*> :: forall a b. Req (a -> b) -> Req a -> Req b
pure :: a -> Req a
$cpure :: forall a. a -> Req a
$cp1Applicative :: Functor Req
Applicative,
      Applicative Req
a -> Req a
Applicative Req
-> (forall a b. Req a -> (a -> Req b) -> Req b)
-> (forall a b. Req a -> Req b -> Req b)
-> (forall a. a -> Req a)
-> Monad Req
Req a -> (a -> Req b) -> Req b
Req a -> Req b -> Req b
forall a. a -> Req a
forall a b. Req a -> Req b -> Req b
forall a b. Req a -> (a -> Req b) -> Req b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Req a
$creturn :: forall a. a -> Req a
>> :: Req a -> Req b -> Req b
$c>> :: forall a b. Req a -> Req b -> Req b
>>= :: Req a -> (a -> Req b) -> Req b
$c>>= :: forall a b. Req a -> (a -> Req b) -> Req b
$cp1Monad :: Applicative Req
Monad,
      Monad Req
Monad Req -> (forall a. IO a -> Req a) -> MonadIO Req
IO a -> Req a
forall a. IO a -> Req a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Req a
$cliftIO :: forall a. IO a -> Req a
$cp1MonadIO :: Monad Req
MonadIO,
      MonadIO Req
MonadIO Req
-> (forall b. ((forall a. Req a -> IO a) -> IO b) -> Req b)
-> MonadUnliftIO Req
((forall a. Req a -> IO a) -> IO b) -> Req b
forall b. ((forall a. Req a -> IO a) -> IO b) -> Req b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: ((forall a. Req a -> IO a) -> IO b) -> Req b
$cwithRunInIO :: forall b. ((forall a. Req a -> IO a) -> IO b) -> Req b
$cp1MonadUnliftIO :: MonadIO Req
MonadUnliftIO
    )

-- | @since 3.7.0
deriving instance MonadThrow Req

-- | @since 3.7.0
deriving instance MonadCatch Req

-- | @since 3.7.0
deriving instance MonadMask Req

instance MonadBase IO Req where
  liftBase :: IO α -> Req α
liftBase = IO α -> Req α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadBaseControl IO Req where
  type StM Req a = a
  liftBaseWith :: (RunInBase Req IO -> IO a) -> Req a
liftBaseWith RunInBase Req IO -> IO a
f = ReaderT HttpConfig IO a -> Req a
forall a. ReaderT HttpConfig IO a -> Req a
Req (ReaderT HttpConfig IO a -> Req a)
-> ((HttpConfig -> IO a) -> ReaderT HttpConfig IO a)
-> (HttpConfig -> IO a)
-> Req a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpConfig -> IO a) -> ReaderT HttpConfig IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((HttpConfig -> IO a) -> Req a) -> (HttpConfig -> IO a) -> Req a
forall a b. (a -> b) -> a -> b
$ \HttpConfig
r -> RunInBase Req IO -> IO a
f (HttpConfig -> Req a -> IO a
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
r)
  {-# INLINEABLE liftBaseWith #-}
  restoreM :: StM Req a -> Req a
restoreM = ReaderT HttpConfig IO a -> Req a
forall a. ReaderT HttpConfig IO a -> Req a
Req (ReaderT HttpConfig IO a -> Req a)
-> (a -> ReaderT HttpConfig IO a) -> a -> Req a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpConfig -> IO a) -> ReaderT HttpConfig IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((HttpConfig -> IO a) -> ReaderT HttpConfig IO a)
-> (a -> HttpConfig -> IO a) -> a -> ReaderT HttpConfig IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> HttpConfig -> IO a
forall a b. a -> b -> a
const (IO a -> HttpConfig -> IO a)
-> (a -> IO a) -> a -> HttpConfig -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINEABLE restoreM #-}

instance MonadHttp Req where
  handleHttpException :: HttpException -> Req a
handleHttpException = ReaderT HttpConfig IO a -> Req a
forall a. ReaderT HttpConfig IO a -> Req a
Req (ReaderT HttpConfig IO a -> Req a)
-> (HttpException -> ReaderT HttpConfig IO a)
-> HttpException
-> Req a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT HttpConfig IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> ReaderT HttpConfig IO a)
-> (HttpException -> IO a)
-> HttpException
-> ReaderT HttpConfig IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> IO a
forall e a. Exception e => e -> IO a
throwIO
  getHttpConfig :: Req HttpConfig
getHttpConfig = ReaderT HttpConfig IO HttpConfig -> Req HttpConfig
forall a. ReaderT HttpConfig IO a -> Req a
Req ReaderT HttpConfig IO HttpConfig
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | @since 3.10.0
instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where
  handleHttpException :: HttpException -> AccumT w m a
handleHttpException = m a -> AccumT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AccumT w m a)
-> (HttpException -> m a) -> HttpException -> AccumT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: AccumT w m HttpConfig
getHttpConfig = m HttpConfig -> AccumT w m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance MonadHttp m => MonadHttp (ContT r m) where
  handleHttpException :: HttpException -> ContT r m a
handleHttpException = m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContT r m a)
-> (HttpException -> m a) -> HttpException -> ContT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: ContT r m HttpConfig
getHttpConfig = m HttpConfig -> ContT r m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance MonadHttp m => MonadHttp (ExceptT e m) where
  handleHttpException :: HttpException -> ExceptT e m a
handleHttpException = m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e m a)
-> (HttpException -> m a) -> HttpException -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: ExceptT e m HttpConfig
getHttpConfig = m HttpConfig -> ExceptT e m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance MonadHttp m => MonadHttp (IdentityT m) where
  handleHttpException :: HttpException -> IdentityT m a
handleHttpException = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a)
-> (HttpException -> m a) -> HttpException -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: IdentityT m HttpConfig
getHttpConfig = m HttpConfig -> IdentityT m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance MonadHttp m => MonadHttp (MaybeT m) where
  handleHttpException :: HttpException -> MaybeT m a
handleHttpException = m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MaybeT m a)
-> (HttpException -> m a) -> HttpException -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: MaybeT m HttpConfig
getHttpConfig = m HttpConfig -> MaybeT m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance MonadHttp m => MonadHttp (ReaderT r m) where
  handleHttpException :: HttpException -> ReaderT r m a
handleHttpException = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (HttpException -> m a) -> HttpException -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: ReaderT r m HttpConfig
getHttpConfig = m HttpConfig -> ReaderT r m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance (MonadHttp m, Monoid w) => MonadHttp (RWS.CPS.RWST r w s m) where
  handleHttpException :: HttpException -> RWST r w s m a
handleHttpException = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (HttpException -> m a) -> HttpException -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = m HttpConfig -> RWST r w s m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Lazy.RWST r w s m) where
  handleHttpException :: HttpException -> RWST r w s m a
handleHttpException = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (HttpException -> m a) -> HttpException -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = m HttpConfig -> RWST r w s m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Strict.RWST r w s m) where
  handleHttpException :: HttpException -> RWST r w s m a
handleHttpException = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (HttpException -> m a) -> HttpException -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = m HttpConfig -> RWST r w s m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance MonadHttp m => MonadHttp (SelectT r m) where
  handleHttpException :: HttpException -> SelectT r m a
handleHttpException = m a -> SelectT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> SelectT r m a)
-> (HttpException -> m a) -> HttpException -> SelectT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: SelectT r m HttpConfig
getHttpConfig = m HttpConfig -> SelectT r m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance MonadHttp m => MonadHttp (State.Lazy.StateT s m) where
  handleHttpException :: HttpException -> StateT s m a
handleHttpException = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (HttpException -> m a) -> HttpException -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: StateT s m HttpConfig
getHttpConfig = m HttpConfig -> StateT s m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance MonadHttp m => MonadHttp (State.Strict.StateT s m) where
  handleHttpException :: HttpException -> StateT s m a
handleHttpException = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (HttpException -> m a) -> HttpException -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: StateT s m HttpConfig
getHttpConfig = m HttpConfig -> StateT s m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance (MonadHttp m, Monoid w) => MonadHttp (Writer.CPS.WriterT w m) where
  handleHttpException :: HttpException -> WriterT w m a
handleHttpException = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (HttpException -> m a) -> HttpException -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = m HttpConfig -> WriterT w m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Lazy.WriterT w m) where
  handleHttpException :: HttpException -> WriterT w m a
handleHttpException = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (HttpException -> m a) -> HttpException -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = m HttpConfig -> WriterT w m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | @since 3.10.0
instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Strict.WriterT w m) where
  handleHttpException :: HttpException -> WriterT w m a
handleHttpException = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (HttpException -> m a) -> HttpException -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
  getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = m HttpConfig -> WriterT w m HttpConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig

-- | Run a computation in the 'Req' monad with the given 'HttpConfig'. In
-- the case of an exceptional situation an 'HttpException' will be thrown.
--
-- @since 0.4.0
runReq ::
  MonadIO m =>
  -- | 'HttpConfig' to use
  HttpConfig ->
  -- | Computation to run
  Req a ->
  m a
runReq :: HttpConfig -> Req a -> m a
runReq HttpConfig
config (Req ReaderT HttpConfig IO a
m) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT HttpConfig IO a -> HttpConfig -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT HttpConfig IO a
m HttpConfig
config)

----------------------------------------------------------------------------
-- Request—Method

-- $method
--
-- The package supports all methods as defined by RFC 2616, and 'PATCH'
-- which is defined by RFC 5789—that should be enough to talk to RESTful
-- APIs. In some cases, however, you may want to add more methods (e.g. you
-- work with WebDAV <https://en.wikipedia.org/wiki/WebDAV>); no need to
-- compromise on type safety and hack, it only takes a couple of seconds to
-- define a new method that will works seamlessly, see 'HttpMethod'.

-- | 'GET' method.
data GET = GET

instance HttpMethod GET where
  type AllowsBody GET = 'NoBody
  httpMethodName :: Proxy GET -> ByteString
httpMethodName Proxy GET
Proxy = ByteString
Y.methodGet

-- | 'POST' method.
data POST = POST

instance HttpMethod POST where
  type AllowsBody POST = 'CanHaveBody
  httpMethodName :: Proxy POST -> ByteString
httpMethodName Proxy POST
Proxy = ByteString
Y.methodPost

-- | 'HEAD' method.
data HEAD = HEAD

instance HttpMethod HEAD where
  type AllowsBody HEAD = 'NoBody
  httpMethodName :: Proxy HEAD -> ByteString
httpMethodName Proxy HEAD
Proxy = ByteString
Y.methodHead

-- | 'PUT' method.
data PUT = PUT

instance HttpMethod PUT where
  type AllowsBody PUT = 'CanHaveBody
  httpMethodName :: Proxy PUT -> ByteString
httpMethodName Proxy PUT
Proxy = ByteString
Y.methodPut

-- | 'DELETE' method. RFC 7231 allows a payload in DELETE but without
-- semantics.
--
-- __Note__: before version /3.4.0/ this method did not allow request
-- bodies.
data DELETE = DELETE

instance HttpMethod DELETE where
  type AllowsBody DELETE = 'CanHaveBody
  httpMethodName :: Proxy DELETE -> ByteString
httpMethodName Proxy DELETE
Proxy = ByteString
Y.methodDelete

-- | 'TRACE' method.
data TRACE = TRACE

instance HttpMethod TRACE where
  type AllowsBody TRACE = 'CanHaveBody
  httpMethodName :: Proxy TRACE -> ByteString
httpMethodName Proxy TRACE
Proxy = ByteString
Y.methodTrace

-- | 'CONNECT' method.
data CONNECT = CONNECT

instance HttpMethod CONNECT where
  type AllowsBody CONNECT = 'CanHaveBody
  httpMethodName :: Proxy CONNECT -> ByteString
httpMethodName Proxy CONNECT
Proxy = ByteString
Y.methodConnect

-- | 'OPTIONS' method.
data OPTIONS = OPTIONS

instance HttpMethod OPTIONS where
  type AllowsBody OPTIONS = 'NoBody
  httpMethodName :: Proxy OPTIONS -> ByteString
httpMethodName Proxy OPTIONS
Proxy = ByteString
Y.methodOptions

-- | 'PATCH' method.
data PATCH = PATCH

instance HttpMethod PATCH where
  type AllowsBody PATCH = 'CanHaveBody
  httpMethodName :: Proxy PATCH -> ByteString
httpMethodName Proxy PATCH
Proxy = ByteString
Y.methodPatch

-- | A type class for types that can be used as an HTTP method. To define a
-- non-standard method, follow this example that defines @COPY@:
--
-- > data COPY = COPY
-- >
-- > instance HttpMethod COPY where
-- >   type AllowsBody COPY = 'CanHaveBody
-- >   httpMethodName Proxy = "COPY"
class HttpMethod a where
  -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which
  -- tells the rest of the library whether the method can have body or not.
  -- We use the special type 'CanHaveBody' lifted to the kind level instead
  -- of 'Bool' to get more user-friendly compiler messages.
  type AllowsBody a :: CanHaveBody

  -- | Return name of the method as a 'ByteString'.
  httpMethodName :: Proxy a -> ByteString

instance HttpMethod method => RequestComponent (Tagged "method" method) where
  getRequestMod :: Tagged "method" method -> Endo Request
getRequestMod Tagged "method" method
_ = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
    Request
x {method :: ByteString
L.method = Proxy method -> ByteString
forall a. HttpMethod a => Proxy a -> ByteString
httpMethodName (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)}

----------------------------------------------------------------------------
-- Request—URL

-- $url
--
-- We use 'Url's which are correct by construction, see 'Url'. To build a
-- 'Url' from a 'URI', use 'useHttpURI', 'useHttpsURI', or generic 'useURI'.

-- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https'
-- specifying the scheme and host at the same time. Then use the @('/~')@
-- and @('/:')@ operators to grow the path one piece at a time. Every single
-- piece of path will be url(percent)-encoded, so using @('/~')@ and
-- @('/:')@ is the only way to have forward slashes between path segments.
-- This approach makes working with dynamic path segments easy and safe. See
-- examples below how to represent various 'Url's (make sure the
-- @OverloadedStrings@ language extension is enabled).
--
-- ==== __Examples__
--
-- > http "httpbin.org"
-- > -- http://httpbin.org
--
-- > https "httpbin.org"
-- > -- https://httpbin.org
--
-- > https "httpbin.org" /: "encoding" /: "utf8"
-- > -- https://httpbin.org/encoding/utf8
--
-- > https "httpbin.org" /: "foo" /: "bar/baz"
-- > -- https://httpbin.org/foo/bar%2Fbaz
--
-- > https "httpbin.org" /: "bytes" /~ (10 :: Int)
-- > -- https://httpbin.org/bytes/10
--
-- > https "юникод.рф"
-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
  -- NOTE The second value is the path segments in reversed order.
  deriving (Url scheme -> Url scheme -> Bool
(Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Bool) -> Eq (Url scheme)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
/= :: Url scheme -> Url scheme -> Bool
$c/= :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
== :: Url scheme -> Url scheme -> Bool
$c== :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
Eq, Eq (Url scheme)
Eq (Url scheme)
-> (Url scheme -> Url scheme -> Ordering)
-> (Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Url scheme)
-> (Url scheme -> Url scheme -> Url scheme)
-> Ord (Url scheme)
Url scheme -> Url scheme -> Bool
Url scheme -> Url scheme -> Ordering
Url scheme -> Url scheme -> Url scheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (scheme :: Scheme). Eq (Url scheme)
forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
forall (scheme :: Scheme). Url scheme -> Url scheme -> Ordering
forall (scheme :: Scheme). Url scheme -> Url scheme -> Url scheme
min :: Url scheme -> Url scheme -> Url scheme
$cmin :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Url scheme
max :: Url scheme -> Url scheme -> Url scheme
$cmax :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Url scheme
>= :: Url scheme -> Url scheme -> Bool
$c>= :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
> :: Url scheme -> Url scheme -> Bool
$c> :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
<= :: Url scheme -> Url scheme -> Bool
$c<= :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
< :: Url scheme -> Url scheme -> Bool
$c< :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
compare :: Url scheme -> Url scheme -> Ordering
$ccompare :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Ordering
$cp1Ord :: forall (scheme :: Scheme). Eq (Url scheme)
Ord, Int -> Url scheme -> ShowS
[Url scheme] -> ShowS
Url scheme -> String
(Int -> Url scheme -> ShowS)
-> (Url scheme -> String)
-> ([Url scheme] -> ShowS)
-> Show (Url scheme)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (scheme :: Scheme). Int -> Url scheme -> ShowS
forall (scheme :: Scheme). [Url scheme] -> ShowS
forall (scheme :: Scheme). Url scheme -> String
showList :: [Url scheme] -> ShowS
$cshowList :: forall (scheme :: Scheme). [Url scheme] -> ShowS
show :: Url scheme -> String
$cshow :: forall (scheme :: Scheme). Url scheme -> String
showsPrec :: Int -> Url scheme -> ShowS
$cshowsPrec :: forall (scheme :: Scheme). Int -> Url scheme -> ShowS
Show, Typeable (Url scheme)
DataType
Constr
Typeable (Url scheme)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Url scheme -> c (Url scheme))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Url scheme))
-> (Url scheme -> Constr)
-> (Url scheme -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Url scheme)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Url scheme)))
-> ((forall b. Data b => b -> b) -> Url scheme -> Url scheme)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Url scheme -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Url scheme -> r)
-> (forall u. (forall d. Data d => d -> u) -> Url scheme -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Url scheme -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme))
-> Data (Url scheme)
Url scheme -> DataType
Url scheme -> Constr
(forall b. Data b => b -> b) -> Url scheme -> Url scheme
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Url scheme -> u
forall u. (forall d. Data d => d -> u) -> Url scheme -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall (scheme :: Scheme). Typeable scheme => Typeable (Url scheme)
forall (scheme :: Scheme).
Typeable scheme =>
Url scheme -> DataType
forall (scheme :: Scheme). Typeable scheme => Url scheme -> Constr
forall (scheme :: Scheme).
Typeable scheme =>
(forall b. Data b => b -> b) -> Url scheme -> Url scheme
forall (scheme :: Scheme) u.
Typeable scheme =>
Int -> (forall d. Data d => d -> u) -> Url scheme -> u
forall (scheme :: Scheme) u.
Typeable scheme =>
(forall d. Data d => d -> u) -> Url scheme -> [u]
forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, Monad m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (scheme :: Scheme) (c :: * -> *).
Typeable scheme =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
forall (scheme :: Scheme) (c :: * -> *).
Typeable scheme =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme)
forall (scheme :: Scheme) (t :: * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url scheme))
forall (scheme :: Scheme) (t :: * -> * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme))
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Url scheme))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme))
$cUrl :: Constr
$tUrl :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
$cgmapMo :: forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
gmapMp :: (forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
$cgmapMp :: forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
gmapM :: (forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
$cgmapM :: forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, Monad m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Url scheme -> u
$cgmapQi :: forall (scheme :: Scheme) u.
Typeable scheme =>
Int -> (forall d. Data d => d -> u) -> Url scheme -> u
gmapQ :: (forall d. Data d => d -> u) -> Url scheme -> [u]
$cgmapQ :: forall (scheme :: Scheme) u.
Typeable scheme =>
(forall d. Data d => d -> u) -> Url scheme -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
$cgmapQr :: forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
$cgmapQl :: forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
gmapT :: (forall b. Data b => b -> b) -> Url scheme -> Url scheme
$cgmapT :: forall (scheme :: Scheme).
Typeable scheme =>
(forall b. Data b => b -> b) -> Url scheme -> Url scheme
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme))
$cdataCast2 :: forall (scheme :: Scheme) (t :: * -> * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Url scheme))
$cdataCast1 :: forall (scheme :: Scheme) (t :: * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url scheme))
dataTypeOf :: Url scheme -> DataType
$cdataTypeOf :: forall (scheme :: Scheme).
Typeable scheme =>
Url scheme -> DataType
toConstr :: Url scheme -> Constr
$ctoConstr :: forall (scheme :: Scheme). Typeable scheme => Url scheme -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
$cgunfold :: forall (scheme :: Scheme) (c :: * -> *).
Typeable scheme =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme)
$cgfoldl :: forall (scheme :: Scheme) (c :: * -> *).
Typeable scheme =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme)
$cp1Data :: forall (scheme :: Scheme). Typeable scheme => Typeable (Url scheme)
Data, Typeable, (forall x. Url scheme -> Rep (Url scheme) x)
-> (forall x. Rep (Url scheme) x -> Url scheme)
-> Generic (Url scheme)
forall x. Rep (Url scheme) x -> Url scheme
forall x. Url scheme -> Rep (Url scheme) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (scheme :: Scheme) x. Rep (Url scheme) x -> Url scheme
forall (scheme :: Scheme) x. Url scheme -> Rep (Url scheme) x
$cto :: forall (scheme :: Scheme) x. Rep (Url scheme) x -> Url scheme
$cfrom :: forall (scheme :: Scheme) x. Url scheme -> Rep (Url scheme) x
Generic)

type role Url nominal

-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however
-- the derived lift forgets the type of the scheme.
instance Typeable scheme => TH.Lift (Url scheme) where
  lift :: Url scheme -> Q Exp
lift Url scheme
url =
    (forall b. Data b => b -> Maybe (Q Exp)) -> Url scheme -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
TH.dataToExpQ ((Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Q Exp
liftText (Maybe Text -> Maybe (Q Exp))
-> (b -> Maybe Text) -> b -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe Text
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast) Url scheme
url Q Exp -> TypeQ -> Q Exp
`TH.sigE` case Url scheme
url of
      Url Scheme
Http NonEmpty Text
_ -> [t|Url 'Http|]
      Url Scheme
Https NonEmpty Text
_ -> [t|Url 'Https|]
    where
      liftText :: Text -> Q Exp
liftText Text
t = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE 'T.pack) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift (Text -> String
T.unpack Text
t)

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: Url scheme -> Q (TExp (Url scheme))
liftTyped = Q Exp -> Q (TExp (Url scheme))
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp (Url scheme)))
-> (Url scheme -> Q Exp) -> Url scheme -> Q (TExp (Url scheme))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url scheme -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | Given host name, produce a 'Url' which has “http” as its scheme and
-- empty path. This also sets port to @80@.
http :: Text -> Url 'Http
http :: Text -> Url 'Http
http = Scheme -> NonEmpty Text -> Url 'Http
forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
Http (NonEmpty Text -> Url 'Http)
-> (Text -> NonEmpty Text) -> Text -> Url 'Http
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Given host name, produce a 'Url' which has “https” as its scheme and
-- empty path. This also sets port to @443@.
https :: Text -> Url 'Https
https :: Text -> Url 'Https
https = Scheme -> NonEmpty Text -> Url 'Https
forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
Https (NonEmpty Text -> Url 'Https)
-> (Text -> NonEmpty Text) -> Text -> Url 'Https
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Grow a given 'Url' appending a single path segment to it. Note that the
-- path segment can be of any type that is an instance of 'ToHttpApiData'.
infixl 5 /~

(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
Url Scheme
secure NonEmpty Text
path /~ :: Url scheme -> a -> Url scheme
/~ a
segment = Scheme -> NonEmpty Text -> Url scheme
forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
secure (Text -> NonEmpty Text -> NonEmpty Text
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece a
segment) NonEmpty Text
path)

-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases
-- when next URL piece is a 'Data.Text.Text' literal.
infixl 5 /:

(/:) :: Url scheme -> Text -> Url scheme
/: :: Url scheme -> Text -> Url scheme
(/:) = Url scheme -> Text -> Url scheme
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
(/~)

-- | Render a 'Url' as 'Text'.
--
-- @since 3.4.0
renderUrl :: Url scheme -> Text
renderUrl :: Url scheme -> Text
renderUrl = \case
  Url Scheme
Https NonEmpty Text
parts ->
    Text
"https://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> Text
renderParts NonEmpty Text
parts
  Url Scheme
Http NonEmpty Text
parts ->
    Text
"http://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> Text
renderParts NonEmpty Text
parts
  where
    renderParts :: NonEmpty Text -> Text
renderParts NonEmpty Text
parts =
      Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
parts)

-- | The 'useHttpURI' function provides an alternative method to get 'Url'
-- (possibly with some 'Option's) from a 'URI'. This is useful when you are
-- given a URL to query dynamically and don't know it beforehand.
--
-- This function expects the scheme to be “http” and host to be present.
--
-- @since 3.0.0
useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)
useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)
useHttpURI URI
uri = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri Maybe (RText 'Scheme) -> Maybe (RText 'Scheme) -> Bool
forall a. Eq a => a -> a -> Bool
== RText 'Scheme -> Maybe (RText 'Scheme)
forall a. a -> Maybe a
Just [QQ.scheme|http|])
  Url 'Http
urlHead <- Text -> Url 'Http
http (Text -> Url 'Http) -> Maybe Text -> Maybe (Url 'Http)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe Text
uriHost URI
uri
  let url :: Url 'Http
url = case URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
URI.uriPath URI
uri of
        Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing -> Url 'Http
urlHead
        Just (Bool, NonEmpty (RText 'PathPiece))
uriPath -> (Bool, NonEmpty (RText 'PathPiece)) -> Url 'Http -> Url 'Http
forall (scheme :: Scheme).
(Bool, NonEmpty (RText 'PathPiece)) -> Url scheme -> Url scheme
uriPathToUrl (Bool, NonEmpty (RText 'PathPiece))
uriPath Url 'Http
urlHead
  (Url 'Http, Option scheme) -> Maybe (Url 'Http, Option scheme)
forall (m :: * -> *) a. Monad m => a -> m a
return (Url 'Http
url, URI -> Option scheme
forall (scheme :: Scheme). URI -> Option scheme
uriOptions URI
uri)

-- | Just like 'useHttpURI', but expects the “https” scheme.
--
-- @since 3.0.0
useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI URI
uri = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri Maybe (RText 'Scheme) -> Maybe (RText 'Scheme) -> Bool
forall a. Eq a => a -> a -> Bool
== RText 'Scheme -> Maybe (RText 'Scheme)
forall a. a -> Maybe a
Just [QQ.scheme|https|])
  Url 'Https
urlHead <- Text -> Url 'Https
https (Text -> Url 'Https) -> Maybe Text -> Maybe (Url 'Https)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe Text
uriHost URI
uri
  let url :: Url 'Https
url = case URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
URI.uriPath URI
uri of
        Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing -> Url 'Https
urlHead
        Just (Bool, NonEmpty (RText 'PathPiece))
uriPath -> (Bool, NonEmpty (RText 'PathPiece)) -> Url 'Https -> Url 'Https
forall (scheme :: Scheme).
(Bool, NonEmpty (RText 'PathPiece)) -> Url scheme -> Url scheme
uriPathToUrl (Bool, NonEmpty (RText 'PathPiece))
uriPath Url 'Https
urlHead
  (Url 'Https, Option scheme) -> Maybe (Url 'Https, Option scheme)
forall (m :: * -> *) a. Monad m => a -> m a
return (Url 'Https
url, URI -> Option scheme
forall (scheme :: Scheme). URI -> Option scheme
uriOptions URI
uri)

-- | Convert URI path to a 'Url'. Internal.
--
-- @since 3.9.0
uriPathToUrl ::
  (Bool, NonEmpty (URI.RText 'URI.PathPiece)) ->
  Url scheme ->
  Url scheme
uriPathToUrl :: (Bool, NonEmpty (RText 'PathPiece)) -> Url scheme -> Url scheme
uriPathToUrl (Bool
trailingSlash, NonEmpty (RText 'PathPiece)
xs) Url scheme
urlHead =
  if Bool
trailingSlash then Url scheme
path Url scheme -> Text -> Url scheme
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
T.empty else Url scheme
path
  where
    path :: Url scheme
path = (Url scheme -> Text -> Url scheme)
-> Url scheme -> [Text] -> Url scheme
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Url scheme -> Text -> Url scheme
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
(/:) Url scheme
urlHead (RText 'PathPiece -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText (RText 'PathPiece -> Text) -> [RText 'PathPiece] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (RText 'PathPiece) -> [RText 'PathPiece]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (RText 'PathPiece)
xs)

-- | A combination of 'useHttpURI' and 'useHttpsURI' for cases when scheme
-- is not known in advance.
--
-- @since 3.0.0
useURI ::
  URI ->
  Maybe
    ( Either
        (Url 'Http, Option scheme0)
        (Url 'Https, Option scheme1)
    )
useURI :: URI
-> Maybe
     (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
useURI URI
uri =
  ((Url 'Http, Option scheme0)
-> Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1)
forall a b. a -> Either a b
Left ((Url 'Http, Option scheme0)
 -> Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
-> Maybe (Url 'Http, Option scheme0)
-> Maybe
     (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe (Url 'Http, Option scheme0)
forall (scheme :: Scheme). URI -> Maybe (Url 'Http, Option scheme)
useHttpURI URI
uri) Maybe
  (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
-> Maybe
     (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
-> Maybe
     (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Url 'Https, Option scheme1)
-> Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1)
forall a b. b -> Either a b
Right ((Url 'Https, Option scheme1)
 -> Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
-> Maybe (Url 'Https, Option scheme1)
-> Maybe
     (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe (Url 'Https, Option scheme1)
forall (scheme :: Scheme). URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI URI
uri)

-- | An internal helper function to extract host from a 'URI'.
uriHost :: URI -> Maybe Text
uriHost :: URI -> Maybe Text
uriHost URI
uri = case URI -> Either Bool Authority
URI.uriAuthority URI
uri of
  Left Bool
_ -> Maybe Text
forall a. Maybe a
Nothing
  Right URI.Authority {Maybe Word
Maybe UserInfo
RText 'Host
authUserInfo :: Authority -> Maybe UserInfo
authHost :: Authority -> RText 'Host
authPort :: Authority -> Maybe Word
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
..} ->
    Text -> Maybe Text
forall a. a -> Maybe a
Just (RText 'Host -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'Host
authHost)

-- | A quasiquoter to build an 'Url' and 'Option' tuple. The type of the
-- generated expression is @('Url' scheme0, 'Option' scheme1)@ with
-- @scheme0@ being either 'Http' or 'Https' depending on the input.
--
-- @since 3.2.0
urlQ :: TH.QuasiQuoter
urlQ :: QuasiQuoter
urlQ =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> TypeQ)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = \String
str ->
        case Text -> Either SomeException URI
forall (m :: * -> *). MonadThrow m => Text -> m URI
URI.mkURI (String -> Text
T.pack String
str) of
          Left SomeException
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
err)
          Right URI
uri -> case URI
-> Maybe (Either (Url 'Http, Option Any) (Url 'Https, Option Any))
forall (scheme0 :: Scheme) (scheme1 :: Scheme).
URI
-> Maybe
     (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
useURI URI
uri of
            Maybe (Either (Url 'Http, Option Any) (Url 'Https, Option Any))
Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a HTTP or HTTPS URL"
            Just Either (Url 'Http, Option Any) (Url 'Https, Option Any)
eurl ->
              [Q Exp] -> Q Exp
TH.tupE
                [ ((Url 'Http, Option Any) -> Q Exp)
-> ((Url 'Https, Option Any) -> Q Exp)
-> Either (Url 'Http, Option Any) (Url 'Https, Option Any)
-> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Url 'Http -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift (Url 'Http -> Q Exp)
-> ((Url 'Http, Option Any) -> Url 'Http)
-> (Url 'Http, Option Any)
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Url 'Http, Option Any) -> Url 'Http
forall a b. (a, b) -> a
fst) (Url 'Https -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift (Url 'Https -> Q Exp)
-> ((Url 'Https, Option Any) -> Url 'Https)
-> (Url 'Https, Option Any)
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Url 'Https, Option Any) -> Url 'Https
forall a b. (a, b) -> a
fst) Either (Url 'Http, Option Any) (Url 'Https, Option Any)
eurl,
                  [|uriOptions uri|]
                ],
      quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"This usage is not supported",
      quoteType :: String -> TypeQ
quoteType = String -> String -> TypeQ
forall a. HasCallStack => String -> a
error String
"This usage is not supported",
      quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"This usage is not supported"
    }

-- | An internal helper function to extract 'Option's from a 'URI'.
uriOptions :: forall scheme. URI -> Option scheme
uriOptions :: URI -> Option scheme
uriOptions URI
uri =
  [Option scheme] -> Option scheme
forall a. Monoid a => [a] -> a
mconcat
    [ Option scheme
auth,
      Option scheme
query,
      Option scheme
port'
      -- , fragment'
    ]
  where
    (Option scheme
auth, Option scheme
port') =
      case URI -> Either Bool Authority
URI.uriAuthority URI
uri of
        Left Bool
_ -> (Option scheme
forall a. Monoid a => a
mempty, Option scheme
forall a. Monoid a => a
mempty)
        Right URI.Authority {Maybe Word
Maybe UserInfo
RText 'Host
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
authUserInfo :: Authority -> Maybe UserInfo
authHost :: Authority -> RText 'Host
authPort :: Authority -> Maybe Word
..} ->
          let auth0 :: Option scheme
auth0 = case Maybe UserInfo
authUserInfo of
                Maybe UserInfo
Nothing -> Option scheme
forall a. Monoid a => a
mempty
                Just URI.UserInfo {Maybe (RText 'Password)
RText 'Username
uiUsername :: UserInfo -> RText 'Username
uiPassword :: UserInfo -> Maybe (RText 'Password)
uiPassword :: Maybe (RText 'Password)
uiUsername :: RText 'Username
..} ->
                  let username :: ByteString
username = Text -> ByteString
T.encodeUtf8 (RText 'Username -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'Username
uiUsername)
                      password :: ByteString
password = ByteString
-> (RText 'Password -> ByteString)
-> Maybe (RText 'Password)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (Text -> ByteString
T.encodeUtf8 (Text -> ByteString)
-> (RText 'Password -> Text) -> RText 'Password -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText 'Password -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText) Maybe (RText 'Password)
uiPassword
                   in ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe ByteString
username ByteString
password
              port0 :: Option scheme
port0 = case Maybe Word
authPort of
                Maybe Word
Nothing -> Option scheme
forall a. Monoid a => a
mempty
                Just Word
port'' -> Int -> Option scheme
forall (scheme :: Scheme). Int -> Option scheme
port (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
port'')
           in (Option scheme
auth0, Option scheme
port0)
    query :: Option scheme
query =
      let liftQueryParam :: QueryParam -> Option scheme
liftQueryParam = \case
            URI.QueryFlag RText 'QueryKey
t -> Text -> Option scheme
forall param. QueryParam param => Text -> param
queryFlag (RText 'QueryKey -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryKey
t)
            URI.QueryParam RText 'QueryKey
k RText 'QueryValue
v -> RText 'QueryKey -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryKey
k Text -> Text -> Option scheme
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: RText 'QueryValue -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryValue
v
       in [Option scheme] -> Option scheme
forall a. Monoid a => [a] -> a
mconcat (QueryParam -> Option scheme
liftQueryParam (QueryParam -> Option scheme) -> [QueryParam] -> [Option scheme]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> [QueryParam]
URI.uriQuery URI
uri)

-- TODO Blocked on upstream: https://github.com/snoyberg/http-client/issues/424
-- fragment' =
--   case URI.uriFragment uri of
--     Nothing -> mempty
--     Just fragment'' -> fragment (URI.unRText fragment'')

instance RequestComponent (Url scheme) where
  getRequestMod :: Url scheme -> Endo Request
getRequestMod (Url Scheme
scheme NonEmpty Text
segments) = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
    let (Text
host :| [Text]
path) = NonEmpty Text -> NonEmpty Text
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty Text
segments
     in Request
x
          { secure :: Bool
L.secure = case Scheme
scheme of
              Scheme
Http -> Bool
False
              Scheme
Https -> Bool
True,
            port :: Int
L.port = case Scheme
scheme of
              Scheme
Http -> Int
80
              Scheme
Https -> Int
443,
            host :: ByteString
L.host = Bool -> ByteString -> ByteString
Y.urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
host),
            path :: ByteString
L.path =
              (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> ([Text] -> ByteString) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> ([Text] -> Builder) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Builder
Y.encodePathSegments) [Text]
path
          }

----------------------------------------------------------------------------
-- Request—Body

-- $body
--
-- A number of options for request bodies are available. The @Content-Type@
-- header is set for you automatically according to the body option you use
-- (it's always specified in the documentation for a given body option). To
-- add your own way to represent request body, define an instance of
-- 'HttpBody'.

-- | This data type represents empty body of an HTTP request. This is the
-- data type to use with 'HttpMethod's that cannot have a body, as it's the
-- only type for which 'ProvidesBody' returns 'NoBody'.
--
-- Using of this body option does not set the @Content-Type@ header.
data NoReqBody = NoReqBody

instance HttpBody NoReqBody where
  getRequestBody :: NoReqBody -> RequestBody
getRequestBody NoReqBody
NoReqBody = ByteString -> RequestBody
L.RequestBodyBS ByteString
B.empty

-- | This body option allows us to use a JSON object as the request
-- body—probably the most popular format right now. Just wrap a data type
-- that is an instance of 'ToJSON' type class and you are done: it will be
-- converted to JSON and inserted as request body.
--
-- This body option sets the @Content-Type@ header to @\"application/json;
-- charset=utf-8\"@ value.
newtype ReqBodyJson a = ReqBodyJson a

instance ToJSON a => HttpBody (ReqBodyJson a) where
  getRequestBody :: ReqBodyJson a -> RequestBody
getRequestBody (ReqBodyJson a
a) = ByteString -> RequestBody
L.RequestBodyLBS (a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
a)
  getRequestContentType :: ReqBodyJson a -> Maybe ByteString
getRequestContentType ReqBodyJson a
_ = ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"application/json; charset=utf-8"

-- | This body option streams request body from a file. It is expected that
-- the file size does not change during streaming.
--
-- Using of this body option does not set the @Content-Type@ header.
newtype ReqBodyFile = ReqBodyFile FilePath

instance HttpBody ReqBodyFile where
  getRequestBody :: ReqBodyFile -> RequestBody
getRequestBody (ReqBodyFile String
path) =
    IO RequestBody -> RequestBody
LI.RequestBodyIO (String -> IO RequestBody
L.streamFile String
path)

-- | HTTP request body represented by a strict 'ByteString'.
--
-- Using of this body option does not set the @Content-Type@ header.
newtype ReqBodyBs = ReqBodyBs ByteString

instance HttpBody ReqBodyBs where
  getRequestBody :: ReqBodyBs -> RequestBody
getRequestBody (ReqBodyBs ByteString
bs) = ByteString -> RequestBody
L.RequestBodyBS ByteString
bs

-- | HTTP request body represented by a lazy 'BL.ByteString'.
--
-- Using of this body option does not set the @Content-Type@ header.
newtype ReqBodyLbs = ReqBodyLbs BL.ByteString

instance HttpBody ReqBodyLbs where
  getRequestBody :: ReqBodyLbs -> RequestBody
getRequestBody (ReqBodyLbs ByteString
bs) = ByteString -> RequestBody
L.RequestBodyLBS ByteString
bs

-- | URL-encoded body. This can hold a collection of parameters which are
-- encoded similarly to query parameters at the end of query string, with
-- the only difference that they are stored in request body. The similarity
-- is reflected in the API as well, as you can use the same combinators you
-- would use to add query parameters: @('=:')@ and 'queryFlag'.
--
-- This body option sets the @Content-Type@ header to
-- @\"application/x-www-form-urlencoded\"@ value.
newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam

instance HttpBody ReqBodyUrlEnc where
  getRequestBody :: ReqBodyUrlEnc -> RequestBody
getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam [(Text, Maybe Text)]
params)) =
    (ByteString -> RequestBody
L.RequestBodyLBS (ByteString -> RequestBody)
-> (Builder -> ByteString) -> Builder -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString) (Bool -> [(Text, Maybe Text)] -> Builder
Y.renderQueryText Bool
False [(Text, Maybe Text)]
params)
  getRequestContentType :: ReqBodyUrlEnc -> Maybe ByteString
getRequestContentType ReqBodyUrlEnc
_ = ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"application/x-www-form-urlencoded"

-- | An opaque monoidal value that allows to collect URL-encoded parameters
-- to be wrapped in 'ReqBodyUrlEnc'.
newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]
  deriving (b -> FormUrlEncodedParam -> FormUrlEncodedParam
NonEmpty FormUrlEncodedParam -> FormUrlEncodedParam
FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
(FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam)
-> (NonEmpty FormUrlEncodedParam -> FormUrlEncodedParam)
-> (forall b.
    Integral b =>
    b -> FormUrlEncodedParam -> FormUrlEncodedParam)
-> Semigroup FormUrlEncodedParam
forall b.
Integral b =>
b -> FormUrlEncodedParam -> FormUrlEncodedParam
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FormUrlEncodedParam -> FormUrlEncodedParam
$cstimes :: forall b.
Integral b =>
b -> FormUrlEncodedParam -> FormUrlEncodedParam
sconcat :: NonEmpty FormUrlEncodedParam -> FormUrlEncodedParam
$csconcat :: NonEmpty FormUrlEncodedParam -> FormUrlEncodedParam
<> :: FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
$c<> :: FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
Semigroup, Semigroup FormUrlEncodedParam
FormUrlEncodedParam
Semigroup FormUrlEncodedParam
-> FormUrlEncodedParam
-> (FormUrlEncodedParam
    -> FormUrlEncodedParam -> FormUrlEncodedParam)
-> ([FormUrlEncodedParam] -> FormUrlEncodedParam)
-> Monoid FormUrlEncodedParam
[FormUrlEncodedParam] -> FormUrlEncodedParam
FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [FormUrlEncodedParam] -> FormUrlEncodedParam
$cmconcat :: [FormUrlEncodedParam] -> FormUrlEncodedParam
mappend :: FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
$cmappend :: FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
mempty :: FormUrlEncodedParam
$cmempty :: FormUrlEncodedParam
$cp1Monoid :: Semigroup FormUrlEncodedParam
Monoid)

instance QueryParam FormUrlEncodedParam where
  queryParam :: Text -> Maybe a -> FormUrlEncodedParam
queryParam Text
name Maybe a
mvalue =
    [(Text, Maybe Text)] -> FormUrlEncodedParam
FormUrlEncodedParam [(Text
name, a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (a -> Text) -> Maybe a -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mvalue)]
  queryParamToList :: FormUrlEncodedParam -> [(Text, Maybe Text)]
queryParamToList (FormUrlEncodedParam [(Text, Maybe Text)]
p) = [(Text, Maybe Text)]
p

-- | Use 'formToQuery'.
--
-- @since 3.11.0
instance FromForm FormUrlEncodedParam where
  fromForm :: Form -> Either Text FormUrlEncodedParam
fromForm = FormUrlEncodedParam -> Either Text FormUrlEncodedParam
forall a b. b -> Either a b
Right (FormUrlEncodedParam -> Either Text FormUrlEncodedParam)
-> (Form -> FormUrlEncodedParam)
-> Form
-> Either Text FormUrlEncodedParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> FormUrlEncodedParam
forall param f.
(QueryParam param, Monoid param, ToForm f) =>
f -> param
formToQuery

-- | Multipart form data. Please consult the
-- "Network.HTTP.Client.MultipartFormData" module for how to construct
-- parts, then use 'reqBodyMultipart' to create actual request body from the
-- parts. 'reqBodyMultipart' is the only way to get a value of the type
-- 'ReqBodyMultipart', as its constructor is not exported on purpose.
--
-- @since 0.2.0
--
-- ==== __Examples__
--
-- > import Control.Monad.IO.Class
-- > import Data.Default.Class
-- > import Network.HTTP.Req
-- > import qualified Network.HTTP.Client.MultipartFormData as LM
-- >
-- > main :: IO ()
-- > main = runReq def $ do
-- >   body <-
-- >     reqBodyMultipart
-- >       [ LM.partBS "title" "My Image"
-- >       , LM.partFileSource "file1" "/tmp/image.jpg"
-- >       ]
-- >   response <-
-- >     req POST (http "example.com" /: "post")
-- >       body
-- >       bsResponse
-- >       mempty
-- >   liftIO $ print (responseBody response)
data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody

instance HttpBody ReqBodyMultipart where
  getRequestBody :: ReqBodyMultipart -> RequestBody
getRequestBody (ReqBodyMultipart ByteString
_ RequestBody
body) = RequestBody
body
  getRequestContentType :: ReqBodyMultipart -> Maybe ByteString
getRequestContentType (ReqBodyMultipart ByteString
boundary RequestBody
_) =
    ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
"multipart/form-data; boundary=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
boundary)

-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
--
-- @since 0.2.0
reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
reqBodyMultipart :: [Part] -> m ReqBodyMultipart
reqBodyMultipart [Part]
parts = IO ReqBodyMultipart -> m ReqBodyMultipart
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReqBodyMultipart -> m ReqBodyMultipart)
-> IO ReqBodyMultipart -> m ReqBodyMultipart
forall a b. (a -> b) -> a -> b
$ do
  ByteString
boundary <- BodyReader
LM.webkitBoundary
  RequestBody
body <- ByteString -> [Part] -> IO RequestBody
forall (m :: * -> *).
Applicative m =>
ByteString -> [PartM m] -> m RequestBody
LM.renderParts ByteString
boundary [Part]
parts
  ReqBodyMultipart -> IO ReqBodyMultipart
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> RequestBody -> ReqBodyMultipart
ReqBodyMultipart ByteString
boundary RequestBody
body)

-- | A type class for things that can be interpreted as an HTTP
-- 'L.RequestBody'.
class HttpBody body where
  -- | How to get actual 'L.RequestBody'.
  getRequestBody :: body -> L.RequestBody

  -- | This method allows us to optionally specify the value of
  -- @Content-Type@ header that should be used with particular body option.
  -- By default it returns 'Nothing' and so @Content-Type@ is not set.
  getRequestContentType :: body -> Maybe ByteString
  getRequestContentType = Maybe ByteString -> body -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing

-- | The type function recognizes 'NoReqBody' as having 'NoBody', while any
-- other body option 'CanHaveBody'. This forces the user to use 'NoReqBody'
-- with 'GET' method and other methods that should not have body.
type family ProvidesBody body :: CanHaveBody where
  ProvidesBody NoReqBody = 'NoBody
  ProvidesBody body = 'CanHaveBody

-- | This type function allows any HTTP body if method says it
-- 'CanHaveBody'. When the method says it should have 'NoBody', the only
-- body option to use is 'NoReqBody'.
type family
  HttpBodyAllowed
    (allowsBody :: CanHaveBody)
    (providesBody :: CanHaveBody) ::
    Constraint
  where
  HttpBodyAllowed 'NoBody 'NoBody = ()
  HttpBodyAllowed 'CanHaveBody body = ()
  HttpBodyAllowed 'NoBody 'CanHaveBody =
    TypeError
      ('Text "This HTTP method does not allow attaching a request body.")

instance HttpBody body => RequestComponent (Tagged "body" body) where
  getRequestMod :: Tagged "body" body -> Endo Request
getRequestMod (Tagged body
body) = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
    Request
x
      { requestBody :: RequestBody
L.requestBody = body -> RequestBody
forall body. HttpBody body => body -> RequestBody
getRequestBody body
body,
        requestHeaders :: RequestHeaders
L.requestHeaders =
          let old :: RequestHeaders
old = Request -> RequestHeaders
L.requestHeaders Request
x
           in case body -> Maybe ByteString
forall body. HttpBody body => body -> Maybe ByteString
getRequestContentType body
body of
                Maybe ByteString
Nothing -> RequestHeaders
old
                Just ByteString
contentType ->
                  (HeaderName
Y.hContentType, ByteString
contentType) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: RequestHeaders
old
      }

----------------------------------------------------------------------------
-- Request—Optional parameters

-- $optional-parameters
--
-- Optional parameters of request include things like query parameters,
-- headers, port number, etc. All optional parameters have the type
-- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as
-- the last argument of 'req' to specify no optional parameters, or combine
-- 'Option's using 'mappend' or @('<>')@ to have several of them at once.

-- | The opaque 'Option' type is a 'Monoid' you can use to pack collection
-- of optional parameters like query parameters and headers. See sections
-- below to learn which 'Option' primitives are available.
data Option (scheme :: Scheme)
  = Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))

-- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
-- Request to avoid appending to an existing query string in request every
-- time new parameter is added. The additional Maybe (L.Request -> IO
-- L.Request) is a finalizer that will be applied after all other
-- transformations. This is for authentication methods that sign requests
-- based on data in Request.

instance Semigroup (Option scheme) where
  Option Endo ([(Text, Maybe Text)], Request)
er0 Maybe (Request -> IO Request)
mr0 <> :: Option scheme -> Option scheme -> Option scheme
<> Option Endo ([(Text, Maybe Text)], Request)
er1 Maybe (Request -> IO Request)
mr1 =
    Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option
      (Endo ([(Text, Maybe Text)], Request)
er0 Endo ([(Text, Maybe Text)], Request)
-> Endo ([(Text, Maybe Text)], Request)
-> Endo ([(Text, Maybe Text)], Request)
forall a. Semigroup a => a -> a -> a
<> Endo ([(Text, Maybe Text)], Request)
er1)
      (Maybe (Request -> IO Request)
mr0 Maybe (Request -> IO Request)
-> Maybe (Request -> IO Request) -> Maybe (Request -> IO Request)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Request -> IO Request)
mr1)

instance Monoid (Option scheme) where
  mempty :: Option scheme
mempty = Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option Endo ([(Text, Maybe Text)], Request)
forall a. Monoid a => a
mempty Maybe (Request -> IO Request)
forall a. Maybe a
Nothing
  mappend :: Option scheme -> Option scheme -> Option scheme
mappend = Option scheme -> Option scheme -> Option scheme
forall a. Semigroup a => a -> a -> a
(<>)

-- | Use 'formToQuery'.
--
-- @since 3.11.0
instance FromForm (Option scheme) where
  fromForm :: Form -> Either Text (Option scheme)
fromForm = Option scheme -> Either Text (Option scheme)
forall a b. b -> Either a b
Right (Option scheme -> Either Text (Option scheme))
-> (Form -> Option scheme) -> Form -> Either Text (Option scheme)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> Option scheme
forall param f.
(QueryParam param, Monoid param, ToForm f) =>
f -> param
formToQuery

-- | A helper to create an 'Option' that modifies only collection of query
-- parameters. This helper is not a part of the public API.
withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
withQueryParams :: ([(Text, Maybe Text)] -> [(Text, Maybe Text)]) -> Option scheme
withQueryParams [(Text, Maybe Text)] -> [(Text, Maybe Text)]
f = Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option ((([(Text, Maybe Text)], Request)
 -> ([(Text, Maybe Text)], Request))
-> Endo ([(Text, Maybe Text)], Request)
forall a. (a -> a) -> Endo a
Endo (([(Text, Maybe Text)] -> [(Text, Maybe Text)])
-> ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [(Text, Maybe Text)] -> [(Text, Maybe Text)]
f)) Maybe (Request -> IO Request)
forall a. Maybe a
Nothing

-- | A helper to create an 'Option' that modifies only 'L.Request'. This
-- helper is not a part of public API.
withRequest :: (L.Request -> L.Request) -> Option scheme
withRequest :: (Request -> Request) -> Option scheme
withRequest Request -> Request
f = Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option ((([(Text, Maybe Text)], Request)
 -> ([(Text, Maybe Text)], Request))
-> Endo ([(Text, Maybe Text)], Request)
forall a. (a -> a) -> Endo a
Endo ((Request -> Request)
-> ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Request -> Request
f)) Maybe (Request -> IO Request)
forall a. Maybe a
Nothing

instance RequestComponent (Option scheme) where
  getRequestMod :: Option scheme -> Endo Request
getRequestMod (Option Endo ([(Text, Maybe Text)], Request)
f Maybe (Request -> IO Request)
_) = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
    let ([(Text, Maybe Text)]
qparams, Request
x') = Endo ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
forall a. Endo a -> a -> a
appEndo Endo ([(Text, Maybe Text)], Request)
f ([], Request
x)
        query :: ByteString
query = Bool -> Query -> ByteString
Y.renderQuery Bool
True ([(Text, Maybe Text)] -> Query
Y.queryTextToQuery [(Text, Maybe Text)]
qparams)
     in Request
x' {queryString :: ByteString
L.queryString = ByteString
query}

-- | Finalize given 'L.Request' by applying a finalizer from the given
-- 'Option' (if it has any).
finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
finalizeRequest :: Option scheme -> Request -> m Request
finalizeRequest (Option Endo ([(Text, Maybe Text)], Request)
_ Maybe (Request -> IO Request)
mfinalizer) = IO Request -> m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> m Request)
-> (Request -> IO Request) -> Request -> m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> IO Request)
-> Maybe (Request -> IO Request) -> Request -> IO Request
forall a. a -> Maybe a -> a
fromMaybe Request -> IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Request -> IO Request)
mfinalizer

----------------------------------------------------------------------------
-- Request—Optional parameters—Query Parameters

-- $query-parameters
--
-- This section describes a polymorphic interface that can be used to
-- construct query parameters (of the type 'Option') and form URL-encoded
-- bodies (of the type 'FormUrlEncodedParam').

-- | This operator builds a query parameter that will be included in URL of
-- your request after the question sign @?@. This is the same syntax you use
-- with form URL encoded request bodies.
--
-- This operator is defined in terms of 'queryParam':
--
-- > name =: value = queryParam name (pure value)
infix 7 =:

(=:) :: (QueryParam param, ToHttpApiData a) => Text -> a -> param
Text
name =: :: Text -> a -> param
=: a
value = Text -> Maybe a -> param
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
name (a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value)

-- | Construct a flag, that is, a valueless query parameter. For example, in
-- the following URL @\"a\"@ is a flag, while @\"b\"@ is a query parameter
-- with a value:
--
-- > https://httpbin.org/foo/bar?a&b=10
--
-- This operator is defined in terms of 'queryParam':
--
-- > queryFlag name = queryParam name (Nothing :: Maybe ())
queryFlag :: QueryParam param => Text -> param
queryFlag :: Text -> param
queryFlag Text
name = Text -> Maybe () -> param
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
name (Maybe ()
forall a. Maybe a
Nothing :: Maybe ())

-- | Construct query parameters from a 'ToForm' instance. This function
-- produces the same query params as 'Form.urlEncodeAsFormStable'.
--
-- Note that 'Form.Form' doesn't have the concept of parameters with the
-- empty value (i.e. what you can get by @key =: ""@). If the value is
-- empty, it will be encoded as a valueless parameter (i.e. what you can get
-- by @queryFlag key@).
--
-- @since 3.11.0
formToQuery :: (QueryParam param, Monoid param, ToForm f) => f -> param
formToQuery :: f -> param
formToQuery f
f = [param] -> param
forall a. Monoid a => [a] -> a
mconcat ([param] -> param) -> (Form -> [param]) -> Form -> param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> param) -> [(Text, Text)] -> [param]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> param
forall param a.
(QueryParam param, ToHttpApiData a, Eq a, IsString a) =>
(Text, a) -> param
toParam ([(Text, Text)] -> [param])
-> (Form -> [(Text, Text)]) -> Form -> [param]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> [(Text, Text)]
Form.toListStable (Form -> param) -> Form -> param
forall a b. (a -> b) -> a -> b
$ f -> Form
forall a. ToForm a => a -> Form
toForm f
f
  where
    toParam :: (Text, a) -> param
toParam (Text
key, a
val) =
      Text -> Maybe a -> param
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
key (Maybe a -> param) -> Maybe a -> param
forall a b. (a -> b) -> a -> b
$
        if a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
""
          then Maybe a
forall a. Maybe a
Nothing
          else a -> Maybe a
forall a. a -> Maybe a
Just a
val

-- | A type class for query-parameter-like things. The reason to have an
-- overloaded 'queryParam' is to be able to use it as an 'Option' and as a
-- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.
-- Having the same syntax for these cases seems natural and user-friendly.
class QueryParam param where
  -- | Create a query parameter with given name and value. If value is
  -- 'Nothing', it won't be included at all (i.e. you create a flag this
  -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
  -- method, because they are easier to read.
  queryParam :: ToHttpApiData a => Text -> Maybe a -> param

  -- | Get the query parameter names and values set by 'queryParam'.
  --
  -- @since 3.11.0
  queryParamToList :: param -> [(Text, Maybe Text)]

instance QueryParam (Option scheme) where
  queryParam :: Text -> Maybe a -> Option scheme
queryParam Text
name Maybe a
mvalue =
    ([(Text, Maybe Text)] -> [(Text, Maybe Text)]) -> Option scheme
forall (scheme :: Scheme).
([(Text, Maybe Text)] -> [(Text, Maybe Text)]) -> Option scheme
withQueryParams ((:) (Text
name, a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (a -> Text) -> Maybe a -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mvalue))
  queryParamToList :: Option scheme -> [(Text, Maybe Text)]
queryParamToList (Option Endo ([(Text, Maybe Text)], Request)
f Maybe (Request -> IO Request)
_) = ([(Text, Maybe Text)], Request) -> [(Text, Maybe Text)]
forall a b. (a, b) -> a
fst (([(Text, Maybe Text)], Request) -> [(Text, Maybe Text)])
-> ([(Text, Maybe Text)], Request) -> [(Text, Maybe Text)]
forall a b. (a -> b) -> a -> b
$ Endo ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
forall a. Endo a -> a -> a
appEndo Endo ([(Text, Maybe Text)], Request)
f ([], Request
L.defaultRequest)

----------------------------------------------------------------------------
-- Request—Optional parameters—Headers

-- | Create an 'Option' that adds a header. Note that if you 'mappend' two
-- headers with the same names the leftmost header will win. This means, in
-- particular, that you cannot create a request with several headers of the
-- same name.
header ::
  -- | Header name
  ByteString ->
  -- | Header value
  ByteString ->
  Option scheme
header :: ByteString -> ByteString -> Option scheme
header ByteString
name ByteString
value = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest (ByteString -> ByteString -> Request -> Request
attachHeader ByteString
name ByteString
value)

-- | Attach a header with given name and content to a 'L.Request'.
--
-- @since 1.1.0
attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
attachHeader :: ByteString -> ByteString -> Request -> Request
attachHeader ByteString
name ByteString
value Request
x =
  Request
x {requestHeaders :: RequestHeaders
L.requestHeaders = (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk ByteString
name, ByteString
value) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
L.requestHeaders Request
x}

-- | Same as 'header', but with redacted values on print.
--
-- @since 3.13.0
headerRedacted :: ByteString -> ByteString -> Option scheme
headerRedacted :: ByteString -> ByteString -> Option scheme
headerRedacted ByteString
name ByteString
value = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
  let y :: Request
y = ByteString -> ByteString -> Request -> Request
attachHeader ByteString
name ByteString
value Request
x
   in Request
y {redactHeaders :: Set HeaderName
L.redactHeaders = ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk ByteString
name HeaderName -> Set HeaderName -> Set HeaderName
forall a. Ord a => a -> Set a -> Set a
`S.insert` Request -> Set HeaderName
L.redactHeaders Request
y}

----------------------------------------------------------------------------
-- Request—Optional parameters—Cookies

-- $cookies
--
-- Support for cookies is quite minimalistic at the moment. It's possible to
-- specify which cookies to send using 'cookieJar' and inspect 'L.Response'
-- to extract 'L.CookieJar' from it (see 'responseCookieJar').

-- | Use the given 'L.CookieJar'. A 'L.CookieJar' can be obtained from a
-- 'L.Response' record.
cookieJar :: L.CookieJar -> Option scheme
cookieJar :: CookieJar -> Option scheme
cookieJar CookieJar
jar = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
  Request
x {cookieJar :: Maybe CookieJar
L.cookieJar = CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just CookieJar
jar}

----------------------------------------------------------------------------
-- Request—Optional parameters—Authentication

-- $authentication
--
-- This section provides the common authentication helpers in the form of
-- 'Option's. You should always prefer the provided authentication 'Option's
-- to manual construction of headers because it ensures that you only use
-- one authentication method at a time (they overwrite each other) and
-- provides additional type safety that prevents leaking of credentials in
-- the cases when authentication relies on HTTPS for encrypting sensitive
-- data.

-- | The 'Option' adds basic authentication.
--
-- See also: <https://en.wikipedia.org/wiki/Basic_access_authentication>.
basicAuth ::
  -- | Username
  ByteString ->
  -- | Password
  ByteString ->
  -- | Auth 'Option'
  Option 'Https
basicAuth :: ByteString -> ByteString -> Option 'Https
basicAuth = ByteString -> ByteString -> Option 'Https
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe

-- | An alternative to 'basicAuth' which works for any scheme. Note that
-- using basic access authentication without SSL\/TLS is vulnerable to
-- attacks. Use 'basicAuth' instead unless you know what you are doing.
--
-- @since 0.3.1
basicAuthUnsafe ::
  -- | Username
  ByteString ->
  -- | Password
  ByteString ->
  -- | Auth 'Option'
  Option scheme
basicAuthUnsafe :: ByteString -> ByteString -> Option scheme
basicAuthUnsafe ByteString
username ByteString
password =
  (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
    (Request -> IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> IO Request)
-> (Request -> Request) -> Request -> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
L.applyBasicAuth ByteString
username ByteString
password)

-- | The 'Option' set basic proxy authentication header.
--
-- @since 1.1.0
basicProxyAuth ::
  -- | Username
  ByteString ->
  -- | Password
  ByteString ->
  -- | Auth 'Option'
  Option scheme
basicProxyAuth :: ByteString -> ByteString -> Option scheme
basicProxyAuth ByteString
username ByteString
password =
  (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest (ByteString -> ByteString -> Request -> Request
L.applyBasicProxyAuth ByteString
username ByteString
password)

-- | The 'Option' adds OAuth1 authentication.
--
-- @since 0.2.0
oAuth1 ::
  -- | Consumer token
  ByteString ->
  -- | Consumer secret
  ByteString ->
  -- | OAuth token
  ByteString ->
  -- | OAuth token secret
  ByteString ->
  -- | Auth 'Option'
  Option scheme
oAuth1 :: ByteString
-> ByteString -> ByteString -> ByteString -> Option scheme
oAuth1 ByteString
consumerToken ByteString
consumerSecret ByteString
token ByteString
tokenSecret =
  (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth (OAuth -> Credential -> Request -> IO Request
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m Request
OAuth.signOAuth OAuth
app Credential
creds)
  where
    app :: OAuth
app =
      OAuth
OAuth.newOAuth
        { oauthConsumerKey :: ByteString
OAuth.oauthConsumerKey = ByteString
consumerToken,
          oauthConsumerSecret :: ByteString
OAuth.oauthConsumerSecret = ByteString
consumerSecret
        }
    creds :: Credential
creds = ByteString -> ByteString -> Credential
OAuth.newCredential ByteString
token ByteString
tokenSecret

-- | The 'Option' adds an OAuth2 bearer token. This is treated by many
-- services as the equivalent of a username and password.
--
-- The 'Option' is defined as:
--
-- > oAuth2Bearer token = header "Authorization" ("Bearer " <> token)
--
-- See also: <https://en.wikipedia.org/wiki/OAuth>.
oAuth2Bearer ::
  -- | Token
  ByteString ->
  -- | Auth 'Option'
  Option 'Https
oAuth2Bearer :: ByteString -> Option 'Https
oAuth2Bearer ByteString
token =
  (Request -> IO Request) -> Option 'Https
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
    (Request -> IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> IO Request)
-> (Request -> Request) -> Request -> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
attachHeader ByteString
"Authorization" (ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
token))

-- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems
-- to be used only by GitHub). This will be treated by whatever services
-- accept it as the equivalent of a username and password.
--
-- The 'Option' is defined as:
--
-- > oAuth2Token token = header "Authorization" ("token" <> token)
--
-- See also: <https://developer.github.com/v3/oauth#3-use-the-access-token-to-access-the-api>.
oAuth2Token ::
  -- | Token
  ByteString ->
  -- | Auth 'Option'
  Option 'Https
oAuth2Token :: ByteString -> Option 'Https
oAuth2Token ByteString
token =
  (Request -> IO Request) -> Option 'Https
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
    (Request -> IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> IO Request)
-> (Request -> Request) -> Request -> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
attachHeader ByteString
"Authorization" (ByteString
"token " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
token))

-- | A helper to create custom authentication 'Option's. The given
-- 'IO'-enabled request transformation is applied after all other
-- modifications when constructing a request. Use wisely.
--
-- @since 1.1.0
customAuth :: (L.Request -> IO L.Request) -> Option scheme
customAuth :: (Request -> IO Request) -> Option scheme
customAuth = Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option Endo ([(Text, Maybe Text)], Request)
forall a. Monoid a => a
mempty (Maybe (Request -> IO Request) -> Option scheme)
-> ((Request -> IO Request) -> Maybe (Request -> IO Request))
-> (Request -> IO Request)
-> Option scheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> IO Request) -> Maybe (Request -> IO Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

----------------------------------------------------------------------------
-- Request—Optional parameters—Other

-- | Specify the port to connect to explicitly. Normally, 'Url' you use
-- determines the default port: @80@ for HTTP and @443@ for HTTPS. This
-- 'Option' allows us to choose an arbitrary port overwriting the defaults.
port :: Int -> Option scheme
port :: Int -> Option scheme
port Int
n = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
  Request
x {port :: Int
L.port = Int
n}

-- | This 'Option' controls whether gzipped data should be decompressed on
-- the fly. By default everything except for @\"application\/x-tar\"@ is
-- decompressed, i.e. we have:
--
-- > decompress (/= "application/x-tar")
--
-- You can also choose to decompress everything like this:
--
-- > decompress (const True)
decompress ::
  -- | Predicate that is given MIME type, it returns 'True' when content
  -- should be decompressed on the fly.
  (ByteString -> Bool) ->
  Option scheme
decompress :: (ByteString -> Bool) -> Option scheme
decompress ByteString -> Bool
f = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
  Request
x {decompress :: ByteString -> Bool
L.decompress = ByteString -> Bool
f}

-- | Specify the number of microseconds to wait for response. The default
-- value is 30 seconds (defined in 'L.ManagerSettings' of connection
-- 'L.Manager').
responseTimeout ::
  -- | Number of microseconds to wait
  Int ->
  Option scheme
responseTimeout :: Int -> Option scheme
responseTimeout Int
n = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
  Request
x {responseTimeout :: ResponseTimeout
L.responseTimeout = Int -> ResponseTimeout
LI.ResponseTimeoutMicro Int
n}

-- | HTTP version to send to the server, the default is HTTP 1.1.
httpVersion ::
  -- | Major version number
  Int ->
  -- | Minor version number
  Int ->
  Option scheme
httpVersion :: Int -> Int -> Option scheme
httpVersion Int
major Int
minor = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
  Request
x {requestVersion :: HttpVersion
L.requestVersion = Int -> Int -> HttpVersion
Y.HttpVersion Int
major Int
minor}

----------------------------------------------------------------------------
-- Response interpretations

-- | Make a request and ignore the body of the response.
newtype IgnoreResponse = IgnoreResponse (L.Response ())
  deriving (Int -> IgnoreResponse -> ShowS
[IgnoreResponse] -> ShowS
IgnoreResponse -> String
(Int -> IgnoreResponse -> ShowS)
-> (IgnoreResponse -> String)
-> ([IgnoreResponse] -> ShowS)
-> Show IgnoreResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IgnoreResponse] -> ShowS
$cshowList :: [IgnoreResponse] -> ShowS
show :: IgnoreResponse -> String
$cshow :: IgnoreResponse -> String
showsPrec :: Int -> IgnoreResponse -> ShowS
$cshowsPrec :: Int -> IgnoreResponse -> ShowS
Show)

instance HttpResponse IgnoreResponse where
  type HttpResponseBody IgnoreResponse = ()
  toVanillaResponse :: IgnoreResponse -> Response (HttpResponseBody IgnoreResponse)
toVanillaResponse (IgnoreResponse Response ()
r) = Response ()
Response (HttpResponseBody IgnoreResponse)
r
  getHttpResponse :: Response BodyReader -> IO IgnoreResponse
getHttpResponse Response BodyReader
r = IgnoreResponse -> IO IgnoreResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (IgnoreResponse -> IO IgnoreResponse)
-> IgnoreResponse -> IO IgnoreResponse
forall a b. (a -> b) -> a -> b
$ Response () -> IgnoreResponse
IgnoreResponse (Response BodyReader -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response BodyReader
r)

-- | Use this as the fourth argument of 'req' to specify that you want it to
-- ignore the response body.
ignoreResponse :: Proxy IgnoreResponse
ignoreResponse :: Proxy IgnoreResponse
ignoreResponse = Proxy IgnoreResponse
forall k (t :: k). Proxy t
Proxy

-- | Make a request and interpret the body of the response as JSON. The
-- 'handleHttpException' method of 'MonadHttp' instance corresponding to
-- monad in which you use 'req' will determine what to do in the case when
-- parsing fails (the 'JsonHttpException' constructor will be used).
newtype JsonResponse a = JsonResponse (L.Response a)
  deriving (Int -> JsonResponse a -> ShowS
[JsonResponse a] -> ShowS
JsonResponse a -> String
(Int -> JsonResponse a -> ShowS)
-> (JsonResponse a -> String)
-> ([JsonResponse a] -> ShowS)
-> Show (JsonResponse a)
forall a. Show a => Int -> JsonResponse a -> ShowS
forall a. Show a => [JsonResponse a] -> ShowS
forall a. Show a => JsonResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonResponse a] -> ShowS
$cshowList :: forall a. Show a => [JsonResponse a] -> ShowS
show :: JsonResponse a -> String
$cshow :: forall a. Show a => JsonResponse a -> String
showsPrec :: Int -> JsonResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> JsonResponse a -> ShowS
Show)

instance FromJSON a => HttpResponse (JsonResponse a) where
  type HttpResponseBody (JsonResponse a) = a
  toVanillaResponse :: JsonResponse a -> Response (HttpResponseBody (JsonResponse a))
toVanillaResponse (JsonResponse Response a
r) = Response a
Response (HttpResponseBody (JsonResponse a))
r
  getHttpResponse :: Response BodyReader -> IO (JsonResponse a)
getHttpResponse Response BodyReader
r = do
    [ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r)
    case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ([ByteString] -> ByteString
BL.fromChunks [ByteString]
chunks) of
      Left String
e -> HttpException -> IO (JsonResponse a)
forall e a. Exception e => e -> IO a
throwIO (String -> HttpException
JsonHttpException String
e)
      Right a
x -> JsonResponse a -> IO (JsonResponse a)
forall (m :: * -> *) a. Monad m => a -> m a
return (JsonResponse a -> IO (JsonResponse a))
-> JsonResponse a -> IO (JsonResponse a)
forall a b. (a -> b) -> a -> b
$ Response a -> JsonResponse a
forall a. Response a -> JsonResponse a
JsonResponse (a
x a -> Response BodyReader -> Response a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)
  acceptHeader :: Proxy (JsonResponse a) -> Maybe ByteString
acceptHeader Proxy (JsonResponse a)
Proxy = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"application/json"

-- | Use this as the fourth argument of 'req' to specify that you want it to
-- return the 'JsonResponse' interpretation.
jsonResponse :: Proxy (JsonResponse a)
jsonResponse :: Proxy (JsonResponse a)
jsonResponse = Proxy (JsonResponse a)
forall k (t :: k). Proxy t
Proxy

-- | Make a request and interpret the body of the response as a strict
-- 'ByteString'.
newtype BsResponse = BsResponse (L.Response ByteString)
  deriving (Int -> BsResponse -> ShowS
[BsResponse] -> ShowS
BsResponse -> String
(Int -> BsResponse -> ShowS)
-> (BsResponse -> String)
-> ([BsResponse] -> ShowS)
-> Show BsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BsResponse] -> ShowS
$cshowList :: [BsResponse] -> ShowS
show :: BsResponse -> String
$cshow :: BsResponse -> String
showsPrec :: Int -> BsResponse -> ShowS
$cshowsPrec :: Int -> BsResponse -> ShowS
Show)

instance HttpResponse BsResponse where
  type HttpResponseBody BsResponse = ByteString
  toVanillaResponse :: BsResponse -> Response (HttpResponseBody BsResponse)
toVanillaResponse (BsResponse Response ByteString
r) = Response ByteString
Response (HttpResponseBody BsResponse)
r
  getHttpResponse :: Response BodyReader -> IO BsResponse
getHttpResponse Response BodyReader
r = do
    [ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r)
    BsResponse -> IO BsResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (BsResponse -> IO BsResponse) -> BsResponse -> IO BsResponse
forall a b. (a -> b) -> a -> b
$ Response ByteString -> BsResponse
BsResponse ([ByteString] -> ByteString
B.concat [ByteString]
chunks ByteString -> Response BodyReader -> Response ByteString
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)

-- | Use this as the fourth argument of 'req' to specify that you want to
-- interpret the response body as a strict 'ByteString'.
bsResponse :: Proxy BsResponse
bsResponse :: Proxy BsResponse
bsResponse = Proxy BsResponse
forall k (t :: k). Proxy t
Proxy

-- | Make a request and interpret the body of the response as a lazy
-- 'BL.ByteString'.
newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
  deriving (Int -> LbsResponse -> ShowS
[LbsResponse] -> ShowS
LbsResponse -> String
(Int -> LbsResponse -> ShowS)
-> (LbsResponse -> String)
-> ([LbsResponse] -> ShowS)
-> Show LbsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LbsResponse] -> ShowS
$cshowList :: [LbsResponse] -> ShowS
show :: LbsResponse -> String
$cshow :: LbsResponse -> String
showsPrec :: Int -> LbsResponse -> ShowS
$cshowsPrec :: Int -> LbsResponse -> ShowS
Show)

instance HttpResponse LbsResponse where
  type HttpResponseBody LbsResponse = BL.ByteString
  toVanillaResponse :: LbsResponse -> Response (HttpResponseBody LbsResponse)
toVanillaResponse (LbsResponse Response ByteString
r) = Response ByteString
Response (HttpResponseBody LbsResponse)
r
  getHttpResponse :: Response BodyReader -> IO LbsResponse
getHttpResponse Response BodyReader
r = do
    [ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r)
    LbsResponse -> IO LbsResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (LbsResponse -> IO LbsResponse) -> LbsResponse -> IO LbsResponse
forall a b. (a -> b) -> a -> b
$ Response ByteString -> LbsResponse
LbsResponse ([ByteString] -> ByteString
BL.fromChunks [ByteString]
chunks ByteString -> Response BodyReader -> Response ByteString
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)

-- | Use this as the fourth argument of 'req' to specify that you want to
-- interpret the response body as a lazy 'BL.ByteString'.
lbsResponse :: Proxy LbsResponse
lbsResponse :: Proxy LbsResponse
lbsResponse = Proxy LbsResponse
forall k (t :: k). Proxy t
Proxy

----------------------------------------------------------------------------
-- Helpers for response interpretations

-- | Fetch beginning of the response and return it together with a new
-- @'L.Response' 'L.BodyReader'@ that can be passed to 'getHttpResponse' and
-- such.
grabPreview ::
  -- | How many bytes to fetch
  Int ->
  -- | Response with body reader inside
  L.Response L.BodyReader ->
  -- | Preview 'ByteString' and new response with body reader inside
  IO (ByteString, L.Response L.BodyReader)
grabPreview :: Int -> Response BodyReader -> IO (ByteString, Response BodyReader)
grabPreview Int
nbytes Response BodyReader
r = do
  let br :: BodyReader
br = Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r
  (ByteString
target, ByteString
leftover, Bool
done) <- BodyReader -> Int -> IO (ByteString, ByteString, Bool)
brReadN BodyReader
br Int
nbytes
  IORef Int
nref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int)
  let br' :: BodyReader
br' = do
        Int
n <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
nref
        let incn :: IO ()
incn = IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Int
nref (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        case Int
n of
          Int
0 -> do
            IO ()
incn
            if ByteString -> Bool
B.null ByteString
target
              then BodyReader
br'
              else ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
target
          Int
1 -> do
            IO ()
incn
            if ByteString -> Bool
B.null ByteString
leftover
              then BodyReader
br'
              else ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
leftover
          Int
_ ->
            if Bool
done
              then ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
              else BodyReader
br
  (ByteString, Response BodyReader)
-> IO (ByteString, Response BodyReader)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
target, Response BodyReader
r {responseBody :: BodyReader
L.responseBody = BodyReader
br'})

-- | Consume N bytes from 'L.BodyReader', return the target chunk, the
-- leftover (may be empty), and whether we're done consuming the body.
brReadN ::
  -- | Body reader to stream from
  L.BodyReader ->
  -- | How many bytes to consume
  Int ->
  -- | Target chunk, the leftover, whether we're done
  IO (ByteString, ByteString, Bool)
brReadN :: BodyReader -> Int -> IO (ByteString, ByteString, Bool)
brReadN BodyReader
br Int
n = Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go Int
0 [ByteString] -> [ByteString]
forall a. a -> a
id [ByteString] -> [ByteString]
forall a. a -> a
id
  where
    go :: Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go !Int
tlen [ByteString] -> [ByteString]
t [ByteString] -> [ByteString]
l = do
      ByteString
chunk <- BodyReader
br
      if ByteString -> Bool
B.null ByteString
chunk
        then (ByteString, ByteString, Bool) -> IO (ByteString, ByteString, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (([ByteString] -> [ByteString]) -> ByteString
forall a. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
t, ([ByteString] -> [ByteString]) -> ByteString
forall a. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
l, Bool
True)
        else do
          let (ByteString
target, ByteString
leftover) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tlen) ByteString
chunk
              tlen' :: Int
tlen' = ByteString -> Int
B.length ByteString
target
              t' :: [ByteString] -> [ByteString]
t' = [ByteString] -> [ByteString]
t ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
target ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
              l' :: [ByteString] -> [ByteString]
l' = [ByteString] -> [ByteString]
l ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
leftover ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
          if Int
tlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tlen' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
            then Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go (Int
tlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tlen') [ByteString] -> [ByteString]
t' [ByteString] -> [ByteString]
l'
            else (ByteString, ByteString, Bool) -> IO (ByteString, ByteString, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (([ByteString] -> [ByteString]) -> ByteString
forall a. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
t', ([ByteString] -> [ByteString]) -> ByteString
forall a. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
l', Bool
False)
    r :: ([a] -> [ByteString]) -> ByteString
r [a] -> [ByteString]
f = [ByteString] -> ByteString
B.concat ([a] -> [ByteString]
f [])

----------------------------------------------------------------------------
-- Inspecting a response

-- | Get the response body.
responseBody ::
  HttpResponse response =>
  response ->
  HttpResponseBody response
responseBody :: response -> HttpResponseBody response
responseBody = Response (HttpResponseBody response) -> HttpResponseBody response
forall body. Response body -> body
L.responseBody (Response (HttpResponseBody response) -> HttpResponseBody response)
-> (response -> Response (HttpResponseBody response))
-> response
-> HttpResponseBody response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse

-- | Get the response status code.
responseStatusCode ::
  HttpResponse response =>
  response ->
  Int
responseStatusCode :: response -> Int
responseStatusCode =
  Status -> Int
Y.statusCode (Status -> Int) -> (response -> Status) -> response -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (HttpResponseBody response) -> Status
forall body. Response body -> Status
L.responseStatus (Response (HttpResponseBody response) -> Status)
-> (response -> Response (HttpResponseBody response))
-> response
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse

-- | Get the response status message.
responseStatusMessage ::
  HttpResponse response =>
  response ->
  ByteString
responseStatusMessage :: response -> ByteString
responseStatusMessage =
  Status -> ByteString
Y.statusMessage (Status -> ByteString)
-> (response -> Status) -> response -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (HttpResponseBody response) -> Status
forall body. Response body -> Status
L.responseStatus (Response (HttpResponseBody response) -> Status)
-> (response -> Response (HttpResponseBody response))
-> response
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse

-- | Lookup a particular header from a response.
responseHeader ::
  HttpResponse response =>
  -- | Response interpretation
  response ->
  -- | Header to lookup
  ByteString ->
  -- | Header value if found
  Maybe ByteString
responseHeader :: response -> ByteString -> Maybe ByteString
responseHeader response
r ByteString
h =
  (HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk ByteString
h) (RequestHeaders -> Maybe ByteString)
-> (response -> RequestHeaders) -> response -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (HttpResponseBody response) -> RequestHeaders
forall body. Response body -> RequestHeaders
L.responseHeaders (Response (HttpResponseBody response) -> RequestHeaders)
-> (response -> Response (HttpResponseBody response))
-> response
-> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse) response
r

-- | Get the response 'L.CookieJar'.
responseCookieJar ::
  HttpResponse response =>
  response ->
  L.CookieJar
responseCookieJar :: response -> CookieJar
responseCookieJar = Response (HttpResponseBody response) -> CookieJar
forall body. Response body -> CookieJar
L.responseCookieJar (Response (HttpResponseBody response) -> CookieJar)
-> (response -> Response (HttpResponseBody response))
-> response
-> CookieJar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse

----------------------------------------------------------------------------
-- Response—Defining your own interpretation

-- $new-response-interpretation
--
-- To create a new response interpretation you just need to make your data
-- type an instance of the 'HttpResponse' type class.

-- | A type class for response interpretations. It allows us to describe how
-- to consume the response from a @'L.Response' 'L.BodyReader'@ and produce
-- the final result that is to be returned to the user.
class HttpResponse response where
  -- | The associated type is the type of body that can be extracted from an
  -- instance of 'HttpResponse'.
  type HttpResponseBody response :: Type

  -- | The method describes how to get the underlying 'L.Response' record.
  toVanillaResponse :: response -> L.Response (HttpResponseBody response)

  -- | This method describes how to consume response body and, more
  -- generally, obtain @response@ value from @'L.Response' 'L.BodyReader'@.
  --
  -- __Note__: 'L.BodyReader' is nothing but @'IO' 'ByteString'@. You should
  -- call this action repeatedly until it yields the empty 'ByteString'. In
  -- that case streaming of response is finished (which apparently leads to
  -- closing of the connection, so don't call the reader after it has
  -- returned the empty 'ByteString' once) and you can concatenate the
  -- chunks to obtain the final result. (Of course you could as well stream
  -- the contents to a file or do whatever you want.)
  --
  -- __Note__: signature of this function was changed in the version
  -- /1.0.0/.
  getHttpResponse ::
    -- | Response with body reader inside
    L.Response L.BodyReader ->
    -- | The final result
    IO response

  -- | The value of @\"Accept\"@ header. This is useful, for example, if a
  -- website supports both @XML@ and @JSON@ responses, and decides what to
  -- reply with based on what @Accept@ headers you have sent.
  --
  -- __Note__: manually specified 'Options' that set the @\"Accept\"@ header
  -- will take precedence.
  --
  -- @since 2.1.0
  acceptHeader :: Proxy response -> Maybe ByteString
  acceptHeader Proxy response
Proxy = Maybe ByteString
forall a. Maybe a
Nothing

-- | This instance has been added to make it easier to inspect 'L.Response'
-- using Req's functions like 'responseStatusCode', 'responseStatusMessage',
-- etc.
--
-- @since 3.12.0
instance HttpResponse (L.Response ()) where
  type HttpResponseBody (L.Response ()) = ()
  toVanillaResponse :: Response () -> Response (HttpResponseBody (Response ()))
toVanillaResponse = Response () -> Response (HttpResponseBody (Response ()))
forall a. a -> a
id
  getHttpResponse :: Response BodyReader -> IO (Response ())
getHttpResponse = Response () -> IO (Response ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Response () -> IO (Response ()))
-> (Response BodyReader -> Response ())
-> Response BodyReader
-> IO (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

----------------------------------------------------------------------------
-- Other

-- | The main class for things that are “parts” of 'L.Request' in the sense
-- that if we have a 'L.Request', then we know how to apply an instance of
-- 'RequestComponent' changing\/overwriting something in it. 'Endo' is a
-- monoid of endomorphisms under composition, it's used to chain different
-- request components easier using @('<>')@.
--
-- __Note__: this type class is not a part of the public API.
class RequestComponent a where
  -- | Get a function that takes a 'L.Request' and changes it somehow
  -- returning another 'L.Request'. For example, the 'HttpMethod' instance
  -- of 'RequestComponent' just overwrites method. The function is wrapped
  -- in 'Endo' so it's easier to chain such “modifying applications”
  -- together building bigger and bigger 'RequestComponent's.
  getRequestMod :: a -> Endo L.Request

-- | This wrapper is only used to attach a type-level tag to a given type.
-- This is necessary to define instances of 'RequestComponent' for any thing
-- that implements 'HttpMethod' or 'HttpBody'. Without the tag, GHC can't
-- see the difference between @'HttpMethod' method => 'RequestComponent'
-- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides
-- which instance to use (i.e. the constraints are taken into account later,
-- when instance is already chosen).
newtype Tagged (tag :: Symbol) a = Tagged a

-- | Exceptions that this library throws.
data HttpException
  = -- | A wrapper with an 'L.HttpException' from "Network.HTTP.Client"
    VanillaHttpException L.HttpException
  | -- | A wrapper with Aeson-produced 'String' describing why decoding
    -- failed
    JsonHttpException String
  deriving (Int -> HttpException -> ShowS
[HttpException] -> ShowS
HttpException -> String
(Int -> HttpException -> ShowS)
-> (HttpException -> String)
-> ([HttpException] -> ShowS)
-> Show HttpException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpException] -> ShowS
$cshowList :: [HttpException] -> ShowS
show :: HttpException -> String
$cshow :: HttpException -> String
showsPrec :: Int -> HttpException -> ShowS
$cshowsPrec :: Int -> HttpException -> ShowS
Show, Typeable, (forall x. HttpException -> Rep HttpException x)
-> (forall x. Rep HttpException x -> HttpException)
-> Generic HttpException
forall x. Rep HttpException x -> HttpException
forall x. HttpException -> Rep HttpException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HttpException x -> HttpException
$cfrom :: forall x. HttpException -> Rep HttpException x
Generic)

instance Exception HttpException

-- | Return 'Just' if the given 'HttpException' is wrapping a http-client's
-- 'L.StatusCodeException'. Otherwise, return 'Nothing'.
--
-- @since 3.12.0
isStatusCodeException :: HttpException -> Maybe (L.Response ())
isStatusCodeException :: HttpException -> Maybe (Response ())
isStatusCodeException
  ( VanillaHttpException
      ( L.HttpExceptionRequest
          Request
_
          (L.StatusCodeException Response ()
r ByteString
_)
        )
    ) = Response () -> Maybe (Response ())
forall a. a -> Maybe a
Just Response ()
r
isStatusCodeException HttpException
_ = Maybe (Response ())
forall a. Maybe a
Nothing

-- | A simple type isomorphic to 'Bool' that we only have for better error
-- messages. We use it as a kind and its data constructors as type-level
-- tags.
--
-- See also: 'HttpMethod' and 'HttpBody'.
data CanHaveBody
  = -- | Indeed can have a body
    CanHaveBody
  | -- | Should not have a body
    NoBody

-- | A type-level tag that specifies URL scheme used (and thus if HTTPS is
-- enabled). This is used to force TLS requirement for some authentication
-- 'Option's.
data Scheme
  = -- | HTTP
    Http
  | -- | HTTPS
    Https
  deriving (Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c== :: Scheme -> Scheme -> Bool
Eq, Eq Scheme
Eq Scheme
-> (Scheme -> Scheme -> Ordering)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Scheme)
-> (Scheme -> Scheme -> Scheme)
-> Ord Scheme
Scheme -> Scheme -> Bool
Scheme -> Scheme -> Ordering
Scheme -> Scheme -> Scheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmax :: Scheme -> Scheme -> Scheme
>= :: Scheme -> Scheme -> Bool
$c>= :: Scheme -> Scheme -> Bool
> :: Scheme -> Scheme -> Bool
$c> :: Scheme -> Scheme -> Bool
<= :: Scheme -> Scheme -> Bool
$c<= :: Scheme -> Scheme -> Bool
< :: Scheme -> Scheme -> Bool
$c< :: Scheme -> Scheme -> Bool
compare :: Scheme -> Scheme -> Ordering
$ccompare :: Scheme -> Scheme -> Ordering
$cp1Ord :: Eq Scheme
Ord, Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scheme] -> ShowS
$cshowList :: [Scheme] -> ShowS
show :: Scheme -> String
$cshow :: Scheme -> String
showsPrec :: Int -> Scheme -> ShowS
$cshowsPrec :: Int -> Scheme -> ShowS
Show, Typeable Scheme
DataType
Constr
Typeable Scheme
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Scheme -> c Scheme)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Scheme)
-> (Scheme -> Constr)
-> (Scheme -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Scheme))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme))
-> ((forall b. Data b => b -> b) -> Scheme -> Scheme)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Scheme -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Scheme -> r)
-> (forall u. (forall d. Data d => d -> u) -> Scheme -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> Data Scheme
Scheme -> DataType
Scheme -> Constr
(forall b. Data b => b -> b) -> Scheme -> Scheme
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
$cHttps :: Constr
$cHttp :: Constr
$tScheme :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapMp :: (forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapM :: (forall d. Data d => d -> m d) -> Scheme -> m Scheme
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapQi :: Int -> (forall d. Data d => d -> u) -> Scheme -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
gmapQ :: (forall d. Data d => d -> u) -> Scheme -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
gmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
$cgmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Scheme)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
dataTypeOf :: Scheme -> DataType
$cdataTypeOf :: Scheme -> DataType
toConstr :: Scheme -> Constr
$ctoConstr :: Scheme -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
$cp1Data :: Typeable Scheme
Data, Typeable, (forall x. Scheme -> Rep Scheme x)
-> (forall x. Rep Scheme x -> Scheme) -> Generic Scheme
forall x. Rep Scheme x -> Scheme
forall x. Scheme -> Rep Scheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scheme x -> Scheme
$cfrom :: forall x. Scheme -> Rep Scheme x
Generic, Scheme -> Q Exp
Scheme -> Q (TExp Scheme)
(Scheme -> Q Exp) -> (Scheme -> Q (TExp Scheme)) -> Lift Scheme
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Scheme -> Q (TExp Scheme)
$cliftTyped :: Scheme -> Q (TExp Scheme)
lift :: Scheme -> Q Exp
$clift :: Scheme -> Q Exp
TH.Lift)