{-# 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 TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Network.HTTP.Req
(
req,
reqBr,
req',
withReqManager,
MonadHttp (..),
HttpConfig (..),
defaultHttpConfig,
Req,
runReq,
GET (..),
POST (..),
HEAD (..),
PUT (..),
DELETE (..),
TRACE (..),
CONNECT (..),
OPTIONS (..),
PATCH (..),
HttpMethod (..),
Url,
http,
https,
(/~),
(/:),
useHttpURI,
useHttpsURI,
useURI,
urlQ,
NoReqBody (..),
ReqBodyJson (..),
ReqBodyFile (..),
ReqBodyBs (..),
ReqBodyLbs (..),
ReqBodyUrlEnc (..),
FormUrlEncodedParam,
ReqBodyMultipart,
reqBodyMultipart,
HttpBody (..),
ProvidesBody,
HttpBodyAllowed,
Option,
(=:),
queryFlag,
QueryParam (..),
header,
attachHeader,
cookieJar,
basicAuth,
basicAuthUnsafe,
basicProxyAuth,
oAuth1,
oAuth2Bearer,
oAuth2Token,
customAuth,
port,
decompress,
responseTimeout,
httpVersion,
IgnoreResponse,
ignoreResponse,
JsonResponse,
jsonResponse,
BsResponse,
bsResponse,
LbsResponse,
lbsResponse,
responseBody,
responseStatusCode,
responseStatusMessage,
responseHeader,
responseCookieJar,
HttpResponse (..),
HttpException (..),
CanHaveBody (..),
Scheme (..),
)
where
import qualified Blaze.ByteString.Builder as BB
import Control.Applicative
import Control.Arrow (first, second)
import Control.Exception hiding (TypeError)
import Control.Monad.Base
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.Control
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 hiding (Option, option)
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.HttpApiData (ToHttpApiData (..))
req ::
( MonadHttp m,
HttpMethod method,
HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
) =>
method ->
Url scheme ->
body ->
Proxy response ->
Option scheme ->
m response
req :: method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req method :: method
method url :: Url scheme
url body :: body
body responseProxy :: Proxy response
responseProxy options :: Option scheme
options =
method
-> Url scheme
-> body
-> Option scheme
-> (Response BodyReader -> IO 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
-> (Response BodyReader -> IO a)
-> m a
reqBr 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) Response BodyReader -> IO response
forall response.
HttpResponse response =>
Response BodyReader -> IO response
getHttpResponse
where
extraOptions :: Option scheme
extraOptions =
case Proxy response -> Maybe ByteString
forall response.
HttpResponse response =>
Proxy response -> Maybe ByteString
acceptHeader Proxy response
responseProxy of
Nothing -> Option scheme
forall a. Monoid a => a
mempty
Just accept :: ByteString
accept -> ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header "Accept" ByteString
accept
reqBr ::
( MonadHttp m,
HttpMethod method,
HttpBody body,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
) =>
method ->
Url scheme ->
body ->
Option scheme ->
(L.Response L.BodyReader -> IO a) ->
m a
reqBr :: method
-> Url scheme
-> body
-> Option scheme
-> (Response BodyReader -> IO a)
-> m a
reqBr method :: method
method url :: Url scheme
url body :: body
body options :: Option scheme
options consume :: 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 ((Request -> Manager -> m a) -> m a)
-> (Request -> Manager -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \request :: Request
request manager :: Manager
manager -> do
HttpConfig {..} <- 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 a -> IO a
wrapExc = (HttpExceptionContentWrapper -> 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)
-> (HttpExceptionContentWrapper -> HttpException)
-> HttpExceptionContentWrapper
-> IO a
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 a) -> m (Either HttpException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException a) -> m (Either HttpException a))
-> (IO a -> IO (Either HttpException a))
-> IO a
-> m (Either HttpException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either HttpException a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO (Either HttpException a))
-> (IO a -> IO a) -> IO a -> IO (Either HttpException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
wrapVanilla (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
wrapExc)
( (IORef (Maybe (Response BodyReader)) -> IO a) -> IO a
forall a c. (IORef (Maybe (Response a)) -> IO c) -> IO c
withRRef ((IORef (Maybe (Response BodyReader)) -> IO a) -> IO a)
-> (IORef (Maybe (Response BodyReader)) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \rref :: 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'
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
(\st :: RetryStatus
st r :: 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
st Response BodyReader
r)
(IO (Response BodyReader) -> RetryStatus -> IO (Response BodyReader)
forall a b. a -> b -> a
const IO (Response BodyReader)
openResponse)
(preview :: ByteString
preview, r' :: Response BodyReader
r') <- Int -> Response BodyReader -> IO (ByteString, Response BodyReader)
grabPreview Int
forall a. Num a => a
bodyPreviewLength 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 a
consume Response BodyReader
r'
)
m (Either HttpException a)
-> (Either HttpException a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HttpException -> m a)
-> (a -> m a) -> Either HttpException a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
req' ::
forall m method body scheme a.
( MonadHttp m,
HttpMethod method,
HttpBody body,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
) =>
method ->
Url scheme ->
body ->
Option scheme ->
(L.Request -> L.Manager -> m a) ->
m a
req' :: method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m a)
-> m a
req' method :: method
method url :: Url scheme
url body :: body
body options :: Option scheme
options m :: Request -> Manager -> m a
m = do
HttpConfig
config <- m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
let
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
$ \x :: 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
$
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
<> Womb "body" body -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod (body -> Womb "body" body
forall (tag :: Symbol) a. a -> Womb tag a
Womb body
body :: Womb "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
<> Womb "method" method -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod (method -> Womb "method" method
forall (tag :: Symbol) a. a -> Womb tag a
Womb method
method :: Womb "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)
withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
withReqManager :: (Manager -> m a) -> m a
withReqManager m :: 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
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 #-}
class MonadIO m => MonadHttp m where
handleHttpException :: HttpException -> m a
getHttpConfig :: m HttpConfig
getHttpConfig = HttpConfig -> m HttpConfig
forall (m :: * -> *) a. Monad m => a -> m a
return HttpConfig
defaultHttpConfig
data HttpConfig = HttpConfig
{
HttpConfig -> Maybe Proxy
httpConfigProxy :: Maybe L.Proxy,
HttpConfig -> Int
httpConfigRedirectCount :: Int,
HttpConfig -> Maybe Manager
httpConfigAltManager :: Maybe L.Manager,
HttpConfig
-> forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse ::
forall b.
L.Request ->
L.Response b ->
ByteString ->
Maybe L.HttpExceptionContent,
HttpConfig -> RetryPolicyM IO
httpConfigRetryPolicy :: RetryPolicyM IO,
HttpConfig -> forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool
}
deriving (Typeable)
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)
-> HttpConfig
HttpConfig
{ httpConfigProxy :: Maybe Proxy
httpConfigProxy = Maybe Proxy
forall a. Maybe a
Nothing,
httpConfigRedirectCount :: Int
httpConfigRedirectCount = 10,
httpConfigAltManager :: Maybe Manager
httpConfigAltManager = Maybe Manager
forall a. Maybe a
Nothing,
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse = \_ response :: Response b
response preview :: ByteString
preview ->
let scode :: Int
scode = Response b -> Int
forall body. Response body -> Int
statusCode Response b
response
in if 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
< 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
RetryPolicy
retryPolicyDefault,
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge = \_ response :: 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` [ 408,
504,
524,
598,
599
]
}
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 {..} = (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
$ \x :: 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
}
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
)
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 f :: 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
$ \r :: 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
runReq ::
MonadIO m =>
HttpConfig ->
Req a ->
m a
runReq :: HttpConfig -> Req a -> m a
runReq config :: HttpConfig
config (Req m :: 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)
data GET = GET
instance HttpMethod GET where
type AllowsBody GET = 'NoBody
httpMethodName :: Proxy GET -> ByteString
httpMethodName Proxy = ByteString
Y.methodGet
data POST = POST
instance HttpMethod POST where
type AllowsBody POST = 'CanHaveBody
httpMethodName :: Proxy POST -> ByteString
httpMethodName Proxy = ByteString
Y.methodPost
data HEAD = HEAD
instance HttpMethod HEAD where
type AllowsBody HEAD = 'NoBody
httpMethodName :: Proxy HEAD -> ByteString
httpMethodName Proxy = ByteString
Y.methodHead
data PUT = PUT
instance HttpMethod PUT where
type AllowsBody PUT = 'CanHaveBody
httpMethodName :: Proxy PUT -> ByteString
httpMethodName Proxy = ByteString
Y.methodPut
data DELETE = DELETE
instance HttpMethod DELETE where
type AllowsBody DELETE = 'NoBody
httpMethodName :: Proxy DELETE -> ByteString
httpMethodName Proxy = ByteString
Y.methodDelete
data TRACE = TRACE
instance HttpMethod TRACE where
type AllowsBody TRACE = 'CanHaveBody
httpMethodName :: Proxy TRACE -> ByteString
httpMethodName Proxy = ByteString
Y.methodTrace
data CONNECT = CONNECT
instance HttpMethod CONNECT where
type AllowsBody CONNECT = 'CanHaveBody
httpMethodName :: Proxy CONNECT -> ByteString
httpMethodName Proxy = ByteString
Y.methodConnect
data OPTIONS = OPTIONS
instance HttpMethod OPTIONS where
type AllowsBody OPTIONS = 'NoBody
httpMethodName :: Proxy OPTIONS -> ByteString
httpMethodName Proxy = ByteString
Y.methodOptions
data PATCH = PATCH
instance HttpMethod PATCH where
type AllowsBody PATCH = 'CanHaveBody
httpMethodName :: Proxy PATCH -> ByteString
httpMethodName Proxy = ByteString
Y.methodPatch
class HttpMethod a where
type AllowsBody a :: CanHaveBody
httpMethodName :: Proxy a -> ByteString
instance HttpMethod method => RequestComponent (Womb "method" method) where
getRequestMod :: Womb "method" method -> Endo Request
getRequestMod _ = (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
$ \x :: 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)}
data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
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)
Constr
DataType
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 -> Constr
Url scheme -> DataType
(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 -> Constr
forall (scheme :: Scheme).
Typeable scheme =>
Url scheme -> DataType
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
instance Typeable scheme => TH.Lift (Url scheme) where
lift :: Url scheme -> Q Exp
lift url :: 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 Http _ -> [t|Url 'Http|]
Url Https _ -> [t|Url 'Https|]
where
liftText :: Text -> Q Exp
liftText t :: 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,16,0)
liftTyped url = TH.TExp <$> TH.lift url
#endif
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
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
infixl 5 /~
(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
Url secure :: Scheme
secure path :: NonEmpty Text
path /~ :: Url scheme -> a -> Url scheme
/~ segment :: 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)
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
(/~)
useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)
useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)
useHttpURI uri :: 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
Nothing -> Url 'Http
urlHead
Just (_, xs :: NonEmpty (RText 'PathPiece)
xs) ->
(Url 'Http -> Text -> Url 'Http)
-> Url 'Http -> [Text] -> Url 'Http
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Url 'Http -> Text -> Url 'Http
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
(/:) Url 'Http
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)
(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)
useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI uri :: 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
Nothing -> Url 'Https
urlHead
Just (_, xs :: NonEmpty (RText 'PathPiece)
xs) ->
(Url 'Https -> Text -> Url 'Https)
-> Url 'Https -> [Text] -> Url 'Https
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
(/:) Url 'Https
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)
(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)
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
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)
uriHost :: URI -> Maybe Text
uriHost :: URI -> Maybe Text
uriHost uri :: URI
uri = case URI -> Either Bool Authority
URI.uriAuthority URI
uri of
Left _ -> Maybe Text
forall a. Maybe a
Nothing
Right URI.Authority {..} ->
Text -> Maybe Text
forall a. a -> Maybe a
Just (RText 'Host -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'Host
authHost)
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 = \str :: String
str ->
case Text -> Either SomeException URI
forall (m :: * -> *). MonadThrow m => Text -> m URI
URI.mkURI (String -> Text
T.pack String
str) of
Left err :: 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
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
Nothing -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Not a HTTP or HTTPS URL"
Just eurl :: 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 "This usage is not supported",
quoteType :: String -> TypeQ
quoteType = String -> String -> TypeQ
forall a. HasCallStack => String -> a
error "This usage is not supported",
quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "This usage is not supported"
}
uriOptions :: forall scheme. URI -> Option scheme
uriOptions :: URI -> Option scheme
uriOptions uri :: URI
uri =
[Option scheme] -> Option scheme
forall a. Monoid a => [a] -> a
mconcat
[ Option scheme
auth,
Option scheme
query,
Option scheme
port'
]
where
(auth :: Option scheme
auth, port' :: Option scheme
port') =
case URI -> Either Bool Authority
URI.uriAuthority URI
uri of
Left _ -> (Option scheme
forall a. Monoid a => a
mempty, Option scheme
forall a. Monoid a => a
mempty)
Right URI.Authority {..} ->
let auth0 :: Option scheme
auth0 = case Maybe UserInfo
authUserInfo of
Nothing -> Option scheme
forall a. Monoid a => a
mempty
Just URI.UserInfo {..} ->
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 "" (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
Nothing -> Option scheme
forall a. Monoid a => a
mempty
Just port'' :: 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 t :: 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 k :: RText 'QueryKey
k v :: 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)
instance RequestComponent (Url scheme) where
getRequestMod :: Url scheme -> Endo Request
getRequestMod (Url scheme :: Scheme
scheme segments :: 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
$ \x :: Request
x ->
let (host :: Text
host :| path :: [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
Http -> Bool
False
Https -> Bool
True,
port :: Int
L.port = case Scheme
scheme of
Http -> 80
Https -> 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
}
data NoReqBody = NoReqBody
instance HttpBody NoReqBody where
getRequestBody :: NoReqBody -> RequestBody
getRequestBody NoReqBody = ByteString -> RequestBody
L.RequestBodyBS ByteString
B.empty
newtype ReqBodyJson a = ReqBodyJson a
instance ToJSON a => HttpBody (ReqBodyJson a) where
getRequestBody :: ReqBodyJson a -> RequestBody
getRequestBody (ReqBodyJson a :: a
a) = ByteString -> RequestBody
L.RequestBodyLBS (a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
a)
getRequestContentType :: ReqBodyJson a -> Maybe ByteString
getRequestContentType _ = ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure "application/json; charset=utf-8"
newtype ReqBodyFile = ReqBodyFile FilePath
instance HttpBody ReqBodyFile where
getRequestBody :: ReqBodyFile -> RequestBody
getRequestBody (ReqBodyFile path :: String
path) =
IO RequestBody -> RequestBody
LI.RequestBodyIO (String -> IO RequestBody
L.streamFile String
path)
newtype ReqBodyBs = ReqBodyBs ByteString
instance HttpBody ReqBodyBs where
getRequestBody :: ReqBodyBs -> RequestBody
getRequestBody (ReqBodyBs bs :: ByteString
bs) = ByteString -> RequestBody
L.RequestBodyBS ByteString
bs
newtype ReqBodyLbs = ReqBodyLbs BL.ByteString
instance HttpBody ReqBodyLbs where
getRequestBody :: ReqBodyLbs -> RequestBody
getRequestBody (ReqBodyLbs bs :: ByteString
bs) = ByteString -> RequestBody
L.RequestBodyLBS ByteString
bs
newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam
instance HttpBody ReqBodyUrlEnc where
getRequestBody :: ReqBodyUrlEnc -> RequestBody
getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam params :: [(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 _ = ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure "application/x-www-form-urlencoded"
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 name :: Text
name mvalue :: 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)]
data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody
instance HttpBody ReqBodyMultipart where
getRequestBody :: ReqBodyMultipart -> RequestBody
getRequestBody (ReqBodyMultipart _ body :: RequestBody
body) = RequestBody
body
getRequestContentType :: ReqBodyMultipart -> Maybe ByteString
getRequestContentType (ReqBodyMultipart boundary :: ByteString
boundary _) =
ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ("multipart/form-data; boundary=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
boundary)
reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
reqBodyMultipart :: [Part] -> m ReqBodyMultipart
reqBodyMultipart parts :: [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)
class HttpBody body where
getRequestBody :: body -> L.RequestBody
getRequestContentType :: body -> Maybe ByteString
getRequestContentType = Maybe ByteString -> body -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing
type family ProvidesBody body :: CanHaveBody where
ProvidesBody NoReqBody = 'NoBody
ProvidesBody body = 'CanHaveBody
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 (Womb "body" body) where
getRequestMod :: Womb "body" body -> Endo Request
getRequestMod (Womb body :: 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
$ \x :: 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
Nothing -> RequestHeaders
old
Just contentType :: ByteString
contentType ->
(HeaderName
Y.hContentType, ByteString
contentType) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: RequestHeaders
old
}
data Option (scheme :: Scheme)
= Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))
instance Semigroup (Option scheme) where
Option er0 :: Endo ([(Text, Maybe Text)], Request)
er0 mr0 :: Maybe (Request -> IO Request)
mr0 <> :: Option scheme -> Option scheme -> Option scheme
<> Option er1 :: Endo ([(Text, Maybe Text)], Request)
er1 mr1 :: 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
(<>)
withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
withQueryParams :: ([(Text, Maybe Text)] -> [(Text, Maybe Text)]) -> Option scheme
withQueryParams f :: [(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
withRequest :: (L.Request -> L.Request) -> Option scheme
withRequest :: (Request -> Request) -> Option scheme
withRequest f :: 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 f :: Endo ([(Text, Maybe Text)], Request)
f _) = (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
$ \x :: Request
x ->
let (qparams :: [(Text, Maybe Text)]
qparams, x' :: 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}
finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
finalizeRequest :: Option scheme -> Request -> m Request
finalizeRequest (Option _ mfinalizer :: 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
infix 7 =:
(=:) :: (QueryParam param, ToHttpApiData a) => Text -> a -> param
name :: Text
name =: :: Text -> a -> param
=: value :: 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)
queryFlag :: QueryParam param => Text -> param
queryFlag :: Text -> param
queryFlag name :: 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 ())
class QueryParam param where
queryParam :: ToHttpApiData a => Text -> Maybe a -> param
instance QueryParam (Option scheme) where
queryParam :: Text -> Maybe a -> Option scheme
queryParam name :: Text
name mvalue :: 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))
header ::
ByteString ->
ByteString ->
Option scheme
name :: ByteString
name value :: ByteString
value = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest (ByteString -> ByteString -> Request -> Request
attachHeader ByteString
name ByteString
value)
attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
name :: ByteString
name value :: ByteString
value x :: 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}
cookieJar :: L.CookieJar -> Option scheme
cookieJar :: CookieJar -> Option scheme
cookieJar jar :: 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
$ \x :: Request
x ->
Request
x {cookieJar :: Maybe CookieJar
L.cookieJar = CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just CookieJar
jar}
basicAuth ::
ByteString ->
ByteString ->
Option 'Https
basicAuth :: ByteString -> ByteString -> Option 'Https
basicAuth = ByteString -> ByteString -> Option 'Https
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe
basicAuthUnsafe ::
ByteString ->
ByteString ->
Option scheme
basicAuthUnsafe :: ByteString -> ByteString -> Option scheme
basicAuthUnsafe username :: ByteString
username password :: 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)
basicProxyAuth ::
ByteString ->
ByteString ->
Option scheme
basicProxyAuth :: ByteString -> ByteString -> Option scheme
basicProxyAuth username :: ByteString
username password :: ByteString
password =
(Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest (ByteString -> ByteString -> Request -> Request
L.applyBasicProxyAuth ByteString
username ByteString
password)
oAuth1 ::
ByteString ->
ByteString ->
ByteString ->
ByteString ->
Option scheme
oAuth1 :: ByteString
-> ByteString -> ByteString -> ByteString -> Option scheme
oAuth1 consumerToken :: ByteString
consumerToken consumerSecret :: ByteString
consumerSecret token :: ByteString
token tokenSecret :: 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
oAuth2Bearer ::
ByteString ->
Option 'Https
oAuth2Bearer :: ByteString -> Option 'Https
oAuth2Bearer token :: 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 "Authorization" ("Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
token))
oAuth2Token ::
ByteString ->
Option 'Https
oAuth2Token :: ByteString -> Option 'Https
oAuth2Token token :: 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 "Authorization" ("token " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
token))
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
port :: Int -> Option scheme
port :: Int -> Option scheme
port n :: 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
$ \x :: Request
x ->
Request
x {port :: Int
L.port = Int
n}
decompress ::
(ByteString -> Bool) ->
Option scheme
decompress :: (ByteString -> Bool) -> Option scheme
decompress f :: 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
$ \x :: Request
x ->
Request
x {decompress :: ByteString -> Bool
L.decompress = ByteString -> Bool
f}
responseTimeout ::
Int ->
Option scheme
responseTimeout :: Int -> Option scheme
responseTimeout n :: 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
$ \x :: Request
x ->
Request
x {responseTimeout :: ResponseTimeout
L.responseTimeout = Int -> ResponseTimeout
LI.ResponseTimeoutMicro Int
n}
httpVersion ::
Int ->
Int ->
Option scheme
httpVersion :: Int -> Int -> Option scheme
httpVersion major :: Int
major minor :: 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
$ \x :: Request
x ->
Request
x {requestVersion :: HttpVersion
L.requestVersion = Int -> Int -> HttpVersion
Y.HttpVersion Int
major Int
minor}
newtype IgnoreResponse = IgnoreResponse (L.Response ())
instance HttpResponse IgnoreResponse where
type HttpResponseBody IgnoreResponse = ()
toVanillaResponse :: IgnoreResponse -> Response (HttpResponseBody IgnoreResponse)
toVanillaResponse (IgnoreResponse r :: Response ()
r) = Response ()
Response (HttpResponseBody IgnoreResponse)
r
getHttpResponse :: Response BodyReader -> IO IgnoreResponse
getHttpResponse r :: 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)
ignoreResponse :: Proxy IgnoreResponse
ignoreResponse :: Proxy IgnoreResponse
ignoreResponse = Proxy IgnoreResponse
forall k (t :: k). Proxy t
Proxy
newtype JsonResponse a = JsonResponse (L.Response a)
instance FromJSON a => HttpResponse (JsonResponse a) where
type HttpResponseBody (JsonResponse a) = a
toVanillaResponse :: JsonResponse a -> Response (HttpResponseBody (JsonResponse a))
toVanillaResponse (JsonResponse r :: Response a
r) = Response a
Response (HttpResponseBody (JsonResponse a))
r
getHttpResponse :: Response BodyReader -> IO (JsonResponse a)
getHttpResponse r :: 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 e :: String
e -> HttpException -> IO (JsonResponse a)
forall e a. Exception e => e -> IO a
throwIO (String -> HttpException
JsonHttpException String
e)
Right x :: 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 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just "application/json"
jsonResponse :: Proxy (JsonResponse a)
jsonResponse :: Proxy (JsonResponse a)
jsonResponse = Proxy (JsonResponse a)
forall k (t :: k). Proxy t
Proxy
newtype BsResponse = BsResponse (L.Response ByteString)
instance HttpResponse BsResponse where
type HttpResponseBody BsResponse = ByteString
toVanillaResponse :: BsResponse -> Response (HttpResponseBody BsResponse)
toVanillaResponse (BsResponse r :: Response ByteString
r) = Response ByteString
Response (HttpResponseBody BsResponse)
r
getHttpResponse :: Response BodyReader -> IO BsResponse
getHttpResponse r :: 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)
bsResponse :: Proxy BsResponse
bsResponse :: Proxy BsResponse
bsResponse = Proxy BsResponse
forall k (t :: k). Proxy t
Proxy
newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
instance HttpResponse LbsResponse where
type HttpResponseBody LbsResponse = BL.ByteString
toVanillaResponse :: LbsResponse -> Response (HttpResponseBody LbsResponse)
toVanillaResponse (LbsResponse r :: Response ByteString
r) = Response ByteString
Response (HttpResponseBody LbsResponse)
r
getHttpResponse :: Response BodyReader -> IO LbsResponse
getHttpResponse r :: 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)
lbsResponse :: Proxy LbsResponse
lbsResponse :: Proxy LbsResponse
lbsResponse = Proxy LbsResponse
forall k (t :: k). Proxy t
Proxy
grabPreview ::
Int ->
L.Response L.BodyReader ->
IO (ByteString, L.Response L.BodyReader)
grabPreview :: Int -> Response BodyReader -> IO (ByteString, Response BodyReader)
grabPreview nbytes :: Int
nbytes r :: Response BodyReader
r = do
let br :: BodyReader
br = Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r
(target :: ByteString
target, leftover :: ByteString
leftover, done :: 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 (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
+ 1)
case Int
n of
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
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
_ ->
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'})
brReadN ::
L.BodyReader ->
Int ->
IO (ByteString, ByteString, Bool)
brReadN :: BodyReader -> Int -> IO (ByteString, ByteString, Bool)
brReadN br :: BodyReader
br n :: Int
n = Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go 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 t :: [ByteString] -> [ByteString]
t l :: [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 (target :: ByteString
target, leftover :: 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 f :: [a] -> [ByteString]
f = [ByteString] -> ByteString
B.concat ([a] -> [ByteString]
f [])
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
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
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
responseHeader ::
HttpResponse response =>
response ->
ByteString ->
Maybe ByteString
r :: response
r h :: 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
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
class HttpResponse response where
type HttpResponseBody response :: Type
toVanillaResponse :: response -> L.Response (HttpResponseBody response)
getHttpResponse ::
L.Response L.BodyReader ->
IO response
:: Proxy response -> Maybe ByteString
acceptHeader Proxy = Maybe ByteString
forall a. Maybe a
Nothing
class RequestComponent a where
getRequestMod :: a -> Endo L.Request
newtype Womb (tag :: Symbol) a = Womb a
data HttpException
=
VanillaHttpException L.HttpException
|
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
data CanHaveBody
=
CanHaveBody
|
NoBody
data Scheme
=
Http
|
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
Constr
DataType
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 -> Constr
Scheme -> DataType
(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 Exp) -> Lift Scheme
forall t. (t -> Q Exp) -> Lift t
lift :: Scheme -> Q Exp
$clift :: Scheme -> Q Exp
TH.Lift)
bodyPreviewLength :: Num a => a
bodyPreviewLength :: a
bodyPreviewLength = 1024