{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Network.HTTP.Req
(
req,
reqBr,
reqCb,
req',
withReqManager,
MonadHttp (..),
HttpConfig (..),
defaultHttpConfig,
Req,
runReq,
GET (..),
POST (..),
HEAD (..),
PUT (..),
DELETE (..),
TRACE (..),
CONNECT (..),
OPTIONS (..),
PATCH (..),
HttpMethod (..),
Url,
http,
https,
(/~),
(/:),
useHttpURI,
useHttpsURI,
useURI,
urlQ,
renderUrl,
NoReqBody (..),
ReqBodyJson (..),
ReqBodyFile (..),
ReqBodyBs (..),
ReqBodyLbs (..),
ReqBodyUrlEnc (..),
FormUrlEncodedParam,
ReqBodyMultipart,
reqBodyMultipart,
HttpBody (..),
ProvidesBody,
HttpBodyAllowed,
Option,
(=:),
queryFlag,
formToQuery,
QueryParam (..),
header,
attachHeader,
headerRedacted,
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 (..),
isStatusCodeException,
CanHaveBody (..),
Scheme (..),
)
where
import Blaze.ByteString.Builder qualified as BB
import Control.Applicative
import Control.Arrow (first, second)
import Control.Exception hiding (Handler (..), TypeError)
import Control.Monad (guard, void, (>=>))
import Control.Monad.Base
import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)
import Control.Monad.Trans.Accum (AccumT)
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Control
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Identity (IdentityT)
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Trans.RWS.CPS qualified as RWS.CPS
import Control.Monad.Trans.RWS.Lazy qualified as RWS.Lazy
import Control.Monad.Trans.RWS.Strict qualified as RWS.Strict
import Control.Monad.Trans.Select (SelectT)
import Control.Monad.Trans.State.Lazy qualified as State.Lazy
import Control.Monad.Trans.State.Strict qualified as State.Strict
import Control.Monad.Trans.Writer.CPS qualified as Writer.CPS
import Control.Monad.Trans.Writer.Lazy qualified as Writer.Lazy
import Control.Monad.Trans.Writer.Strict qualified as Writer.Strict
import Control.Retry
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Lazy qualified as BL
import Data.CaseInsensitive qualified 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 Data.List.NonEmpty qualified as NE
import Data.Maybe (fromMaybe)
import Data.Proxy
import Data.Semigroup (Endo (..))
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Typeable (Typeable, cast)
import GHC.Generics
import GHC.TypeLits
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Quote qualified as TH
import Language.Haskell.TH.Syntax qualified as TH
import Network.Connection qualified as NC
import Network.HTTP.Client qualified as L
import Network.HTTP.Client.Internal qualified as LI
import Network.HTTP.Client.MultipartFormData qualified as LM
import Network.HTTP.Client.TLS qualified as L
import Network.HTTP.Types qualified as Y
import System.IO.Unsafe (unsafePerformIO)
import Text.URI (URI)
import Text.URI qualified as URI
import Text.URI.QQ qualified as QQ
import Web.Authenticate.OAuth qualified as OAuth
import Web.FormUrlEncoded (FromForm (..), ToForm (..))
import Web.FormUrlEncoded qualified as Form
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 :: forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req method
method Url scheme
url body
body Proxy response
responseProxy Option scheme
options =
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> (Request -> m Request)
-> m response
reqCb method
method Url scheme
url body
body Proxy response
responseProxy Option scheme
options forall (f :: * -> *) a. Applicative f => a -> f a
pure
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 :: 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 Response BodyReader -> IO a
consume =
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 (forall (m :: * -> *) b.
MonadHttp m =>
(Response BodyReader -> IO b) -> Request -> Manager -> m b
reqHandler Response BodyReader -> IO a
consume)
reqCb ::
( MonadHttp m,
HttpMethod method,
HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
) =>
method ->
Url scheme ->
body ->
Proxy response ->
Option scheme ->
(L.Request -> m L.Request) ->
m response
reqCb :: forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> (Request -> m Request)
-> m response
reqCb method
method Url scheme
url body
body Proxy response
responseProxy Option scheme
options Request -> m Request
adjustRequest =
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 forall a. Semigroup a => a -> a -> a
<> Option scheme
extraOptions) forall a b. (a -> b) -> a -> b
$ \Request
request Manager
manager -> do
Request
request' <- Request -> m Request
adjustRequest Request
request
forall (m :: * -> *) b.
MonadHttp m =>
(Response BodyReader -> IO b) -> Request -> Manager -> m b
reqHandler forall response.
HttpResponse response =>
Response BodyReader -> IO response
getHttpResponse Request
request' Manager
manager
where
extraOptions :: Option scheme
extraOptions =
case forall response.
HttpResponse response =>
Proxy response -> Maybe ByteString
acceptHeader Proxy response
responseProxy of
Maybe ByteString
Nothing -> forall a. Monoid a => a
mempty
Just ByteString
accept -> forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Accept" ByteString
accept
reqHandler ::
(MonadHttp m) =>
(L.Response L.BodyReader -> IO b) ->
L.Request ->
L.Manager ->
m b
reqHandler :: forall (m :: * -> *) b.
MonadHttp m =>
(Response BodyReader -> IO b) -> Request -> Manager -> m b
reqHandler Response BodyReader -> IO b
consume Request
request Manager
manager = do
HttpConfig {Int
Maybe Proxy
Maybe Manager
RetryPolicyM IO
RetryStatus -> SomeException -> Bool
forall a. Num a => a
forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
forall b. RetryStatus -> Response b -> Bool
httpConfigBodyPreviewLength :: HttpConfig -> forall a. Num a => a
httpConfigRetryJudgeException :: HttpConfig -> RetryStatus -> SomeException -> Bool
httpConfigRetryJudge :: HttpConfig -> forall b. RetryStatus -> Response b -> Bool
httpConfigRetryPolicy :: HttpConfig -> RetryPolicyM IO
httpConfigCheckResponse :: HttpConfig
-> forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigAltManager :: HttpConfig -> Maybe Manager
httpConfigRedirectCount :: HttpConfig -> Int
httpConfigProxy :: HttpConfig -> Maybe Proxy
httpConfigBodyPreviewLength :: forall a. Num a => a
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigAltManager :: Maybe Manager
httpConfigRedirectCount :: Int
httpConfigProxy :: Maybe Proxy
..} <- forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
let wrapVanilla :: IO a -> IO a
wrapVanilla = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> HttpException
VanillaHttpException)
wrapExc :: IO b -> IO b
wrapExc = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (forall e a. Exception e => e -> IO a
throwIO 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 =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing)
(forall a. IORef a -> IO a
readIORef forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Response a -> IO ()
L.responseClose)
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. IO a -> IO a
wrapVanilla forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO b
wrapExc)
( forall {a} {c}. (IORef (Maybe (Response a)) -> IO c) -> IO c
withRRef forall a b. (a -> b) -> a -> b
$ \IORef (Maybe (Response BodyReader))
rref -> do
let openResponse :: IO (Response BodyReader)
openResponse = forall {a}. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
Maybe (Response BodyReader)
r <- forall a. IORef a -> IO a
readIORef IORef (Maybe (Response BodyReader))
rref
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Response BodyReader))
rref (forall a. a -> Maybe a
Just Response BodyReader
r')
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
r'
exceptionRetryPolicies :: [RetryStatus -> Handler IO Bool]
exceptionRetryPolicies =
forall (m :: * -> *). MonadIO m => [RetryStatus -> Handler m Bool]
skipAsyncExceptions
forall a. [a] -> [a] -> [a]
++ [ \RetryStatus
retryStatus -> forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ RetryStatus -> SomeException -> Bool
httpConfigRetryJudgeException RetryStatus
retryStatus SomeException
e
]
Response BodyReader
r <-
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying
RetryPolicyM IO
httpConfigRetryPolicy
(\RetryStatus
retryStatus Response BodyReader
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge RetryStatus
retryStatus Response BodyReader
r)
( forall a b. a -> b -> a
const
( forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering
RetryPolicyM IO
httpConfigRetryPolicy
[RetryStatus -> Handler IO Bool]
exceptionRetryPolicies
(forall a b. a -> b -> a
const IO (Response BodyReader)
openResponse)
)
)
(ByteString
preview, Response BodyReader
r') <- Int -> Response BodyReader -> IO (ByteString, Response BodyReader)
grabPreview forall a. Num a => a
httpConfigBodyPreviewLength Response BodyReader
r
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. HttpExceptionContent -> IO a
LI.throwHttp (forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse Request
request Response BodyReader
r' ByteString
preview)
Response BodyReader -> IO b
consume Response BodyReader
r'
)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException 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' :: 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 = do
HttpConfig
config <- forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
let
nubHeaders :: Endo Request
nubHeaders = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {requestHeaders :: RequestHeaders
L.requestHeaders = forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) (Request -> RequestHeaders
L.requestHeaders Request
x)}
request' :: Request
request' =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo Request
L.defaultRequest forall a b. (a -> b) -> a -> b
$
Endo Request
nubHeaders
forall a. Semigroup a => a -> a -> a
<> forall a. RequestComponent a => a -> Endo Request
getRequestMod Option scheme
options
forall a. Semigroup a => a -> a -> a
<> forall a. RequestComponent a => a -> Endo Request
getRequestMod HttpConfig
config
forall a. Semigroup a => a -> a -> a
<> forall a. RequestComponent a => a -> Endo Request
getRequestMod (forall (tag :: Symbol) a. a -> Tagged tag a
Tagged body
body :: Tagged "body" body)
forall a. Semigroup a => a -> a -> a
<> forall a. RequestComponent a => a -> Endo Request
getRequestMod Url scheme
url
forall a. Semigroup a => a -> a -> a
<> forall a. RequestComponent a => a -> Endo Request
getRequestMod (forall (tag :: Symbol) a. a -> Tagged tag a
Tagged method
method :: Tagged "method" method)
Request
request <- forall (m :: * -> *) (scheme :: Scheme).
MonadIO m =>
Option scheme -> Request -> m Request
finalizeRequest Option scheme
options Request
request'
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 :: forall (m :: * -> *) a. MonadIO m => (Manager -> m a) -> m a
withReqManager Manager -> m a
m = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IORef a -> IO a
readIORef IORef Manager
globalManager) 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 = forall a. IO a -> a
unsafePerformIO 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
(forall a. a -> Maybe a
Just ConnectionContext
context)
(Bool -> Bool -> Bool -> TLSSettings
NC.TLSSettingsSimple Bool
False Bool
False Bool
False)
forall a. Maybe a
Nothing
Manager
manager <- ManagerSettings -> IO Manager
L.newManager ManagerSettings
settings
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 = 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,
HttpConfig -> RetryStatus -> SomeException -> Bool
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool,
HttpConfig -> forall a. Num a => a
httpConfigBodyPreviewLength :: forall a. (Num a) => a
}
deriving (Typeable)
defaultHttpConfig :: HttpConfig
defaultHttpConfig :: HttpConfig
defaultHttpConfig =
HttpConfig
{ httpConfigProxy :: Maybe Proxy
httpConfigProxy = forall a. Maybe a
Nothing,
httpConfigRedirectCount :: Int
httpConfigRedirectCount = Int
10,
httpConfigAltManager :: Maybe Manager
httpConfigAltManager = forall a. Maybe a
Nothing,
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse = \Request
_ Response b
response ByteString
preview ->
let scode :: Int
scode = forall {body}. Response body -> Int
statusCode Response b
response
in if Int
200 forall a. Ord a => a -> a -> Bool
<= Int
scode Bool -> Bool -> Bool
&& Int
scode forall a. Ord a => a -> a -> Bool
< Int
300
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Response () -> ByteString -> HttpExceptionContent
L.StatusCodeException (forall (f :: * -> *) a. Functor f => f a -> f ()
void Response b
response) ByteString
preview),
httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigRetryPolicy = forall (m :: * -> *). Monad m => RetryPolicyM m
retryPolicyDefault,
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge = \RetryStatus
_ Response b
response ->
forall {body}. Response body -> Int
statusCode Response b
response
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Int
408,
Int
504,
Int
524,
Int
598,
Int
599
],
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool
httpConfigRetryJudgeException = \RetryStatus
_ SomeException
e ->
case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (L.HttpExceptionRequest Request
_ HttpExceptionContent
c) ->
case HttpExceptionContent
c of
HttpExceptionContent
L.ResponseTimeout -> Bool
True
HttpExceptionContent
L.ConnectionTimeout -> Bool
True
HttpExceptionContent
_ -> Bool
False
Maybe HttpException
_ -> Bool
False,
httpConfigBodyPreviewLength :: forall a. Num a => a
httpConfigBodyPreviewLength = a
1024
}
where
statusCode :: Response body -> Int
statusCode = Status -> Int
Y.statusCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> Status
L.responseStatus
instance RequestComponent HttpConfig where
getRequestMod :: HttpConfig -> Endo Request
getRequestMod HttpConfig {Int
Maybe Proxy
Maybe Manager
RetryPolicyM IO
RetryStatus -> SomeException -> Bool
forall a. Num a => a
forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
forall b. RetryStatus -> Response b -> Bool
httpConfigBodyPreviewLength :: forall a. Num a => a
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigAltManager :: Maybe Manager
httpConfigRedirectCount :: Int
httpConfigProxy :: Maybe Proxy
httpConfigBodyPreviewLength :: HttpConfig -> forall a. Num a => a
httpConfigRetryJudgeException :: HttpConfig -> RetryStatus -> SomeException -> Bool
httpConfigRetryJudge :: HttpConfig -> forall b. RetryStatus -> Response b -> Bool
httpConfigRetryPolicy :: HttpConfig -> RetryPolicyM IO
httpConfigCheckResponse :: HttpConfig
-> forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigAltManager :: HttpConfig -> Maybe Manager
httpConfigRedirectCount :: HttpConfig -> Int
httpConfigProxy :: HttpConfig -> Maybe Proxy
..} = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x
{ proxy :: Maybe Proxy
L.proxy = Maybe Proxy
httpConfigProxy,
redirectCount :: Int
L.redirectCount = Int
httpConfigRedirectCount,
requestManagerOverride :: Maybe Manager
LI.requestManagerOverride = Maybe Manager
httpConfigAltManager
}
newtype Req a = Req (ReaderT HttpConfig IO a)
deriving
( 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
<$ :: forall a b. a -> Req b -> Req a
$c<$ :: forall a b. a -> Req b -> Req a
fmap :: forall a b. (a -> b) -> Req a -> Req b
$cfmap :: forall a b. (a -> b) -> Req a -> Req b
Functor,
Functor Req
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
<* :: forall a b. Req a -> Req b -> Req a
$c<* :: forall a b. Req a -> Req b -> Req a
*> :: forall a b. Req a -> Req b -> Req b
$c*> :: forall a b. Req a -> Req b -> Req b
liftA2 :: forall a b c. (a -> b -> c) -> Req a -> Req b -> Req c
$cliftA2 :: forall a b c. (a -> b -> c) -> Req a -> Req b -> Req c
<*> :: forall a b. Req (a -> b) -> Req a -> Req b
$c<*> :: forall a b. Req (a -> b) -> Req a -> Req b
pure :: forall a. a -> Req a
$cpure :: forall a. a -> Req a
Applicative,
Applicative Req
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 :: forall a. a -> Req a
$creturn :: forall a. a -> Req a
>> :: forall a b. Req a -> Req b -> Req b
$c>> :: forall a b. Req a -> Req b -> Req b
>>= :: forall a b. Req a -> (a -> Req b) -> Req b
$c>>= :: forall a b. Req a -> (a -> Req b) -> Req b
Monad,
Monad Req
forall a. IO a -> Req a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Req a
$cliftIO :: forall a. IO a -> Req a
MonadIO,
MonadIO Req
forall b. ((forall a. Req a -> IO a) -> IO b) -> Req b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b. ((forall a. Req a -> IO a) -> IO b) -> Req b
$cwithRunInIO :: forall b. ((forall a. Req a -> IO a) -> IO b) -> Req b
MonadUnliftIO
)
deriving instance MonadThrow Req
deriving instance MonadCatch Req
deriving instance MonadMask Req
instance MonadBase IO Req where
liftBase :: forall a. IO a -> Req a
liftBase = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadBaseControl IO Req where
type StM Req a = a
liftBaseWith :: forall a. (RunInBase Req IO -> IO a) -> Req a
liftBaseWith RunInBase Req IO -> IO a
f = forall a. ReaderT HttpConfig IO a -> Req a
Req forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \HttpConfig
r -> RunInBase Req IO -> IO a
f (forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
r)
{-# INLINEABLE liftBaseWith #-}
restoreM :: forall a. StM Req a -> Req a
restoreM = forall a. ReaderT HttpConfig IO a -> Req a
Req forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINEABLE restoreM #-}
instance MonadHttp Req where
handleHttpException :: forall a. HttpException -> Req a
handleHttpException = forall a. ReaderT HttpConfig IO a -> Req a
Req forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO
getHttpConfig :: Req HttpConfig
getHttpConfig = forall a. ReaderT HttpConfig IO a -> Req a
Req forall r (m :: * -> *). MonadReader r m => m r
ask
instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where
handleHttpException :: forall a. HttpException -> AccumT w m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: AccumT w m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (ContT r m) where
handleHttpException :: forall a. HttpException -> ContT r m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: ContT r m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (ExceptT e m) where
handleHttpException :: forall a. HttpException -> ExceptT e m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: ExceptT e m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (IdentityT m) where
handleHttpException :: forall a. HttpException -> IdentityT m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: IdentityT m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (MaybeT m) where
handleHttpException :: forall a. HttpException -> MaybeT m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: MaybeT m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (ReaderT r m) where
handleHttpException :: forall a. HttpException -> ReaderT r m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: ReaderT r m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m, Monoid w) => MonadHttp (RWS.CPS.RWST r w s m) where
handleHttpException :: forall a. HttpException -> RWST r w s m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Lazy.RWST r w s m) where
handleHttpException :: forall a. HttpException -> RWST r w s m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Strict.RWST r w s m) where
handleHttpException :: forall a. HttpException -> RWST r w s m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (SelectT r m) where
handleHttpException :: forall a. HttpException -> SelectT r m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: SelectT r m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (State.Lazy.StateT s m) where
handleHttpException :: forall a. HttpException -> StateT s m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: StateT s m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (State.Strict.StateT s m) where
handleHttpException :: forall a. HttpException -> StateT s m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: StateT s m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m, Monoid w) => MonadHttp (Writer.CPS.WriterT w m) where
handleHttpException :: forall a. HttpException -> WriterT w m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Lazy.WriterT w m) where
handleHttpException :: forall a. HttpException -> WriterT w m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Strict.WriterT w m) where
handleHttpException :: forall a. HttpException -> WriterT w m a
handleHttpException = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
runReq ::
(MonadIO m) =>
HttpConfig ->
Req a ->
m a
runReq :: forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
config (Req ReaderT HttpConfig IO a
m) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 GET
Proxy = ByteString
Y.methodGet
data POST = POST
instance HttpMethod POST where
type AllowsBody POST = 'CanHaveBody
httpMethodName :: Proxy POST -> ByteString
httpMethodName Proxy POST
Proxy = ByteString
Y.methodPost
data HEAD = HEAD
instance HttpMethod HEAD where
type AllowsBody HEAD = 'NoBody
httpMethodName :: Proxy HEAD -> ByteString
httpMethodName Proxy HEAD
Proxy = ByteString
Y.methodHead
data PUT = PUT
instance HttpMethod PUT where
type AllowsBody PUT = 'CanHaveBody
httpMethodName :: Proxy PUT -> ByteString
httpMethodName Proxy PUT
Proxy = ByteString
Y.methodPut
data DELETE = DELETE
instance HttpMethod DELETE where
type AllowsBody DELETE = 'CanHaveBody
httpMethodName :: Proxy DELETE -> ByteString
httpMethodName Proxy DELETE
Proxy = ByteString
Y.methodDelete
data TRACE = TRACE
instance HttpMethod TRACE where
type AllowsBody TRACE = 'CanHaveBody
httpMethodName :: Proxy TRACE -> ByteString
httpMethodName Proxy TRACE
Proxy = ByteString
Y.methodTrace
data CONNECT = CONNECT
instance HttpMethod CONNECT where
type AllowsBody CONNECT = 'CanHaveBody
httpMethodName :: Proxy CONNECT -> ByteString
httpMethodName Proxy CONNECT
Proxy = ByteString
Y.methodConnect
data OPTIONS = OPTIONS
instance HttpMethod OPTIONS where
type AllowsBody OPTIONS = 'NoBody
httpMethodName :: Proxy OPTIONS -> ByteString
httpMethodName Proxy OPTIONS
Proxy = ByteString
Y.methodOptions
data PATCH = PATCH
instance HttpMethod PATCH where
type AllowsBody PATCH = 'CanHaveBody
httpMethodName :: Proxy PATCH -> ByteString
httpMethodName Proxy PATCH
Proxy = ByteString
Y.methodPatch
class HttpMethod a where
type AllowsBody a :: CanHaveBody
httpMethodName :: Proxy a -> ByteString
instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
getRequestMod :: Tagged "method" method -> Endo Request
getRequestMod Tagged "method" method
_ = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {method :: ByteString
L.method = forall {k} (a :: k). HttpMethod a => Proxy a -> ByteString
httpMethodName (forall {k} (t :: k). Proxy t
Proxy :: Proxy method)}
data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
deriving (Url scheme -> Url scheme -> Bool
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, Url scheme -> Url scheme -> Bool
Url scheme -> Url scheme -> Ordering
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
Ord, Int -> Url scheme -> ShowS
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, Url scheme -> DataType
Url scheme -> Constr
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 {scheme :: Scheme}. Typeable scheme => Typeable (Url scheme)
forall (scheme :: Scheme).
Typeable scheme =>
Url scheme -> DataType
forall (scheme :: Scheme). Typeable scheme => Url scheme -> Constr
forall (scheme :: Scheme).
Typeable scheme =>
(forall b. Data b => b -> b) -> Url scheme -> Url scheme
forall (scheme :: Scheme) u.
Typeable scheme =>
Int -> (forall d. Data d => d -> u) -> Url scheme -> u
forall (scheme :: Scheme) u.
Typeable scheme =>
(forall d. Data d => d -> u) -> Url scheme -> [u]
forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, Monad m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (scheme :: Scheme) (c :: * -> *).
Typeable scheme =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
forall (scheme :: Scheme) (c :: * -> *).
Typeable scheme =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme)
forall (scheme :: Scheme) (t :: * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url scheme))
forall (scheme :: Scheme) (t :: * -> * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme))
forall (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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. 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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data, Typeable, 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 :: forall (m :: * -> *). Quote m => Url scheme -> m Exp
lift Url scheme
url =
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
TH.dataToExpQ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {f :: * -> *}. Quote f => Text -> f Exp
liftText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast) Url scheme
url forall (m :: * -> *). Quote m => m Exp -> m Type -> m Exp
`TH.sigE` case Url scheme
url of
Url Scheme
Http NonEmpty Text
_ -> [t|Url 'Http|]
Url Scheme
Https NonEmpty Text
_ -> [t|Url 'Https|]
where
liftText :: Text -> f Exp
liftText Text
t = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE 'T.pack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift (Text -> String
T.unpack Text
t)
liftTyped :: forall (m :: * -> *). Quote m => Url scheme -> Code m (Url scheme)
liftTyped = forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
TH.unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift
http :: Text -> Url 'Http
http :: Text -> Url 'Http
http = forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
Http forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
https :: Text -> Url 'Https
https :: Text -> Url 'Https
https = forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
Https forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
infixl 5 /~
(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme
Url Scheme
secure NonEmpty Text
path /~ :: forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ a
segment = forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
secure (forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (forall a. ToHttpApiData a => a -> Text
toUrlPiece a
segment) NonEmpty Text
path)
infixl 5 /:
(/:) :: Url scheme -> Text -> Url scheme
/: :: forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
(/:) = forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
(/~)
renderUrl :: Url scheme -> Text
renderUrl :: forall (scheme :: Scheme). Url scheme -> Text
renderUrl = \case
Url Scheme
Https NonEmpty Text
parts ->
Text
"https://" forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> Text
renderParts NonEmpty Text
parts
Url Scheme
Http NonEmpty Text
parts ->
Text
"http://" forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> Text
renderParts NonEmpty Text
parts
where
renderParts :: NonEmpty Text -> Text
renderParts NonEmpty Text
parts =
Text -> [Text] -> Text
T.intercalate Text
"/" (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
parts)
useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)
useHttpURI :: forall (scheme :: Scheme). URI -> Maybe (Url 'Http, Option scheme)
useHttpURI URI
uri = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just [QQ.scheme|http|])
Url 'Http
urlHead <- Text -> Url 'Http
http forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe Text
uriHost URI
uri
let url :: Url 'Http
url = case URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
URI.uriPath URI
uri of
Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing -> Url 'Http
urlHead
Just (Bool, NonEmpty (RText 'PathPiece))
uriPath -> forall (scheme :: Scheme).
(Bool, NonEmpty (RText 'PathPiece)) -> Url scheme -> Url scheme
uriPathToUrl (Bool, NonEmpty (RText 'PathPiece))
uriPath Url 'Http
urlHead
forall (m :: * -> *) a. Monad m => a -> m a
return (Url 'Http
url, forall (scheme :: Scheme). URI -> Option scheme
uriOptions URI
uri)
useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI :: forall (scheme :: Scheme). URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI URI
uri = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just [QQ.scheme|https|])
Url 'Https
urlHead <- Text -> Url 'Https
https forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe Text
uriHost URI
uri
let url :: Url 'Https
url = case URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
URI.uriPath URI
uri of
Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing -> Url 'Https
urlHead
Just (Bool, NonEmpty (RText 'PathPiece))
uriPath -> forall (scheme :: Scheme).
(Bool, NonEmpty (RText 'PathPiece)) -> Url scheme -> Url scheme
uriPathToUrl (Bool, NonEmpty (RText 'PathPiece))
uriPath Url 'Https
urlHead
forall (m :: * -> *) a. Monad m => a -> m a
return (Url 'Https
url, forall (scheme :: Scheme). URI -> Option scheme
uriOptions URI
uri)
uriPathToUrl ::
(Bool, NonEmpty (URI.RText 'URI.PathPiece)) ->
Url scheme ->
Url scheme
uriPathToUrl :: forall (scheme :: Scheme).
(Bool, NonEmpty (RText 'PathPiece)) -> Url scheme -> Url scheme
uriPathToUrl (Bool
trailingSlash, NonEmpty (RText 'PathPiece)
xs) Url scheme
urlHead =
if Bool
trailingSlash then Url scheme
path forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
T.empty else Url scheme
path
where
path :: Url scheme
path = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
(/:) Url scheme
urlHead (forall (l :: RTextLabel). RText l -> Text
URI.unRText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (RText 'PathPiece)
xs)
useURI ::
URI ->
Maybe
( Either
(Url 'Http, Option scheme0)
(Url 'Https, Option scheme1)
)
useURI :: forall (scheme0 :: Scheme) (scheme1 :: Scheme).
URI
-> Maybe
(Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
useURI URI
uri =
(forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (scheme :: Scheme). URI -> Maybe (Url 'Http, Option scheme)
useHttpURI URI
uri) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (scheme :: Scheme). URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI URI
uri)
uriHost :: URI -> Maybe Text
uriHost :: URI -> Maybe Text
uriHost URI
uri = case URI -> Either Bool Authority
URI.uriAuthority URI
uri of
Left Bool
_ -> forall a. Maybe a
Nothing
Right URI.Authority {Maybe Word
Maybe UserInfo
RText 'Host
authUserInfo :: Authority -> Maybe UserInfo
authHost :: Authority -> RText 'Host
authPort :: Authority -> Maybe Word
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
..} ->
forall a. a -> Maybe a
Just (forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'Host
authHost)
urlQ :: TH.QuasiQuoter
urlQ :: QuasiQuoter
urlQ =
TH.QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = \String
str ->
case forall (m :: * -> *). MonadThrow m => Text -> m URI
URI.mkURI (String -> Text
T.pack String
str) of
Left SomeException
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall e. Exception e => e -> String
displayException SomeException
err)
Right URI
uri -> case forall (scheme0 :: Scheme) (scheme1 :: Scheme).
URI
-> Maybe
(Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
useURI URI
uri of
Maybe (Either (Url 'Http, Option Any) (Url 'Https, Option Any))
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a HTTP or HTTPS URL"
Just Either (Url 'Http, Option Any) (Url 'Https, Option Any)
eurl ->
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.tupE
[ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Either (Url 'Http, Option Any) (Url 'Https, Option Any)
eurl,
[|uriOptions uri|]
],
quotePat :: String -> Q Pat
quotePat = forall a. HasCallStack => String -> a
error String
"This usage is not supported",
quoteType :: String -> Q Type
quoteType = forall a. HasCallStack => String -> a
error String
"This usage is not supported",
quoteDec :: String -> Q [Dec]
quoteDec = forall a. HasCallStack => String -> a
error String
"This usage is not supported"
}
uriOptions :: forall scheme. URI -> Option scheme
uriOptions :: forall (scheme :: Scheme). URI -> Option scheme
uriOptions URI
uri =
forall a. Monoid a => [a] -> a
mconcat
[ Option scheme
auth,
Option scheme
query,
Option scheme
port'
]
where
(Option scheme
auth, Option scheme
port') =
case URI -> Either Bool Authority
URI.uriAuthority URI
uri of
Left Bool
_ -> (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
Right URI.Authority {Maybe Word
Maybe UserInfo
RText 'Host
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
authUserInfo :: Authority -> Maybe UserInfo
authHost :: Authority -> RText 'Host
authPort :: Authority -> Maybe Word
..} ->
let auth0 :: Option scheme
auth0 = case Maybe UserInfo
authUserInfo of
Maybe UserInfo
Nothing -> forall a. Monoid a => a
mempty
Just URI.UserInfo {Maybe (RText 'Password)
RText 'Username
uiUsername :: UserInfo -> RText 'Username
uiPassword :: UserInfo -> Maybe (RText 'Password)
uiPassword :: Maybe (RText 'Password)
uiUsername :: RText 'Username
..} ->
let username :: ByteString
username = Text -> ByteString
T.encodeUtf8 (forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'Username
uiUsername)
password :: ByteString
password = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: RTextLabel). RText l -> Text
URI.unRText) Maybe (RText 'Password)
uiPassword
in forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe ByteString
username ByteString
password
port0 :: Option scheme
port0 = case Maybe Word
authPort of
Maybe Word
Nothing -> forall a. Monoid a => a
mempty
Just Word
port'' -> forall (scheme :: Scheme). Int -> Option scheme
port (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
port'')
in (Option scheme
auth0, Option scheme
port0)
query :: Option scheme
query =
let liftQueryParam :: QueryParam -> Option scheme
liftQueryParam = \case
URI.QueryFlag RText 'QueryKey
t -> forall param. QueryParam param => Text -> param
queryFlag (forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryKey
t)
URI.QueryParam RText 'QueryKey
k RText 'QueryValue
v -> forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryKey
k forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryValue
v
in forall a. Monoid a => [a] -> a
mconcat (QueryParam -> Option scheme
liftQueryParam 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 NonEmpty Text
segments) = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \Request
x ->
let (Text
host :| [Text]
path) = forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty Text
segments
in Request
x
{ secure :: Bool
L.secure = case Scheme
scheme of
Scheme
Http -> Bool
False
Scheme
Https -> Bool
True,
port :: Int
L.port = case Scheme
scheme of
Scheme
Http -> Int
80
Scheme
Https -> Int
443,
host :: ByteString
L.host = Bool -> ByteString -> ByteString
Y.urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
host),
path :: ByteString
L.path =
(ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString 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
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) = ByteString -> RequestBody
L.RequestBodyLBS (forall a. ToJSON a => a -> ByteString
A.encode a
a)
getRequestContentType :: ReqBodyJson a -> Maybe ByteString
getRequestContentType ReqBodyJson a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"application/json; charset=utf-8"
newtype ReqBodyFile = ReqBodyFile FilePath
instance HttpBody ReqBodyFile where
getRequestBody :: ReqBodyFile -> RequestBody
getRequestBody (ReqBodyFile String
path) =
IO RequestBody -> RequestBody
LI.RequestBodyIO (String -> IO RequestBody
L.streamFile String
path)
newtype ReqBodyBs = ReqBodyBs ByteString
instance HttpBody ReqBodyBs where
getRequestBody :: ReqBodyBs -> RequestBody
getRequestBody (ReqBodyBs ByteString
bs) = ByteString -> RequestBody
L.RequestBodyBS ByteString
bs
newtype ReqBodyLbs = ReqBodyLbs BL.ByteString
instance HttpBody ReqBodyLbs where
getRequestBody :: ReqBodyLbs -> RequestBody
getRequestBody (ReqBodyLbs ByteString
bs) = ByteString -> RequestBody
L.RequestBodyLBS ByteString
bs
newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam
instance HttpBody ReqBodyUrlEnc where
getRequestBody :: ReqBodyUrlEnc -> RequestBody
getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam [(Text, Maybe Text)]
params)) =
(ByteString -> RequestBody
L.RequestBodyLBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString) (Bool -> [(Text, Maybe Text)] -> Builder
Y.renderQueryText Bool
False [(Text, Maybe Text)]
params)
getRequestContentType :: ReqBodyUrlEnc -> Maybe ByteString
getRequestContentType ReqBodyUrlEnc
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"application/x-www-form-urlencoded"
newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]
deriving (NonEmpty FormUrlEncodedParam -> FormUrlEncodedParam
FormUrlEncodedParam -> FormUrlEncodedParam -> 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 :: forall b.
Integral b =>
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
[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
Monoid)
instance QueryParam FormUrlEncodedParam where
queryParam :: forall a. ToHttpApiData a => Text -> Maybe a -> FormUrlEncodedParam
queryParam Text
name Maybe a
mvalue =
[(Text, Maybe Text)] -> FormUrlEncodedParam
FormUrlEncodedParam [(Text
name, forall a. ToHttpApiData a => a -> Text
toQueryParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mvalue)]
queryParamToList :: FormUrlEncodedParam -> [(Text, Maybe Text)]
queryParamToList (FormUrlEncodedParam [(Text, Maybe Text)]
p) = [(Text, Maybe Text)]
p
instance FromForm FormUrlEncodedParam where
fromForm :: Form -> Either Text FormUrlEncodedParam
fromForm = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall param f.
(QueryParam param, Monoid param, ToForm f) =>
f -> param
formToQuery
data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody
instance HttpBody ReqBodyMultipart where
getRequestBody :: ReqBodyMultipart -> RequestBody
getRequestBody (ReqBodyMultipart ByteString
_ RequestBody
body) = RequestBody
body
getRequestContentType :: ReqBodyMultipart -> Maybe ByteString
getRequestContentType (ReqBodyMultipart ByteString
boundary RequestBody
_) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
"multipart/form-data; boundary=" forall a. Semigroup a => a -> a -> a
<> ByteString
boundary)
reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart
reqBodyMultipart :: forall (m :: * -> *). MonadIO m => [Part] -> m ReqBodyMultipart
reqBodyMultipart [Part]
parts = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
ByteString
boundary <- BodyReader
LM.webkitBoundary
RequestBody
body <- forall (m :: * -> *).
Applicative m =>
ByteString -> [PartM m] -> m RequestBody
LM.renderParts ByteString
boundary [Part]
parts
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 = forall a b. a -> b -> a
const 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 (Tagged "body" body) where
getRequestMod :: Tagged "body" body -> Endo Request
getRequestMod (Tagged body
body) = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x
{ requestBody :: RequestBody
L.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 forall body. HttpBody body => body -> Maybe ByteString
getRequestContentType body
body of
Maybe ByteString
Nothing -> RequestHeaders
old
Just ByteString
contentType ->
(HeaderName
Y.hContentType, ByteString
contentType) 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 Endo ([(Text, Maybe Text)], Request)
er0 Maybe (Request -> IO Request)
mr0 <> :: Option scheme -> Option scheme -> Option scheme
<> Option Endo ([(Text, Maybe Text)], Request)
er1 Maybe (Request -> IO Request)
mr1 =
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option
(Endo ([(Text, Maybe Text)], Request)
er0 forall a. Semigroup a => a -> a -> a
<> Endo ([(Text, Maybe Text)], Request)
er1)
(Maybe (Request -> IO Request)
mr0 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 = forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option forall a. Monoid a => a
mempty forall a. Maybe a
Nothing
mappend :: Option scheme -> Option scheme -> Option scheme
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance FromForm (Option scheme) where
fromForm :: Form -> Either Text (Option scheme)
fromForm = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall param f.
(QueryParam param, Monoid param, ToForm f) =>
f -> param
formToQuery
withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
withQueryParams :: forall (scheme :: Scheme).
([(Text, Maybe Text)] -> [(Text, Maybe Text)]) -> Option scheme
withQueryParams [(Text, Maybe Text)] -> [(Text, Maybe Text)]
f = forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option (forall a. (a -> a) -> Endo a
Endo (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [(Text, Maybe Text)] -> [(Text, Maybe Text)]
f)) forall a. Maybe a
Nothing
withRequest :: (L.Request -> L.Request) -> Option scheme
withRequest :: forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest Request -> Request
f = forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option (forall a. (a -> a) -> Endo a
Endo (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Request -> Request
f)) forall a. Maybe a
Nothing
instance RequestComponent (Option scheme) where
getRequestMod :: Option scheme -> Endo Request
getRequestMod (Option Endo ([(Text, Maybe Text)], Request)
f Maybe (Request -> IO Request)
_) = forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \Request
x ->
let ([(Text, Maybe Text)]
qparams, Request
x') = 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 :: forall (m :: * -> *) (scheme :: Scheme).
MonadIO m =>
Option scheme -> Request -> m Request
finalizeRequest (Option Endo ([(Text, Maybe Text)], Request)
_ Maybe (Request -> IO Request)
mfinalizer) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Request -> IO Request)
mfinalizer
infix 7 =:
(=:) :: (QueryParam param, ToHttpApiData a) => Text -> a -> param
Text
name =: :: forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: a
value = forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
name (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value)
queryFlag :: (QueryParam param) => Text -> param
queryFlag :: forall param. QueryParam param => Text -> param
queryFlag Text
name = forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
name (forall a. Maybe a
Nothing :: Maybe ())
formToQuery :: (QueryParam param, Monoid param, ToForm f) => f -> param
formToQuery :: forall param f.
(QueryParam param, Monoid param, ToForm f) =>
f -> param
formToQuery f
f = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {param} {a}.
(QueryParam param, ToHttpApiData a, Eq a, IsString a) =>
(Text, a) -> param
toParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> [(Text, Text)]
Form.toListStable forall a b. (a -> b) -> a -> b
$ forall a. ToForm a => a -> Form
toForm f
f
where
toParam :: (Text, a) -> param
toParam (Text
key, a
val) =
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
key forall a b. (a -> b) -> a -> b
$
if a
val forall a. Eq a => a -> a -> Bool
== a
""
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just a
val
class QueryParam param where
queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param
queryParamToList :: param -> [(Text, Maybe Text)]
instance QueryParam (Option scheme) where
queryParam :: forall a. ToHttpApiData a => Text -> Maybe a -> Option scheme
queryParam Text
name Maybe a
mvalue =
forall (scheme :: Scheme).
([(Text, Maybe Text)] -> [(Text, Maybe Text)]) -> Option scheme
withQueryParams ((:) (Text
name, forall a. ToHttpApiData a => a -> Text
toQueryParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mvalue))
queryParamToList :: Option scheme -> [(Text, Maybe Text)]
queryParamToList (Option Endo ([(Text, Maybe Text)], Request)
f Maybe (Request -> IO Request)
_) = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Endo a -> a -> a
appEndo Endo ([(Text, Maybe Text)], Request)
f ([], Request
L.defaultRequest)
header ::
ByteString ->
ByteString ->
Option scheme
ByteString
name ByteString
value = forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest (ByteString -> ByteString -> Request -> Request
attachHeader ByteString
name ByteString
value)
attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
ByteString
name ByteString
value Request
x =
Request
x {requestHeaders :: RequestHeaders
L.requestHeaders = (forall s. FoldCase s => s -> CI s
CI.mk ByteString
name, ByteString
value) forall a. a -> [a] -> [a]
: Request -> RequestHeaders
L.requestHeaders Request
x}
headerRedacted :: ByteString -> ByteString -> Option scheme
ByteString
name ByteString
value = forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest forall a b. (a -> b) -> a -> b
$ \Request
x ->
let y :: Request
y = ByteString -> ByteString -> Request -> Request
attachHeader ByteString
name ByteString
value Request
x
in Request
y {redactHeaders :: Set HeaderName
L.redactHeaders = forall s. FoldCase s => s -> CI s
CI.mk ByteString
name forall a. Ord a => a -> Set a -> Set a
`S.insert` Request -> Set HeaderName
L.redactHeaders Request
y}
cookieJar :: L.CookieJar -> Option scheme
cookieJar :: forall (scheme :: Scheme). CookieJar -> Option scheme
cookieJar CookieJar
jar = forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {cookieJar :: Maybe CookieJar
L.cookieJar = forall a. a -> Maybe a
Just CookieJar
jar}
basicAuth ::
ByteString ->
ByteString ->
Option 'Https
basicAuth :: ByteString -> ByteString -> Option 'Https
basicAuth = forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe
basicAuthUnsafe ::
ByteString ->
ByteString ->
Option scheme
basicAuthUnsafe :: forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe ByteString
username ByteString
password =
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
(forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicProxyAuth ByteString
username ByteString
password =
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 :: forall (scheme :: Scheme).
ByteString
-> ByteString -> ByteString -> ByteString -> Option scheme
oAuth1 ByteString
consumerToken ByteString
consumerSecret ByteString
token ByteString
tokenSecret =
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth (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 ByteString
token =
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
attachHeader ByteString
"Authorization" (ByteString
"Bearer " forall a. Semigroup a => a -> a -> a
<> ByteString
token))
oAuth2Token ::
ByteString ->
Option 'Https
oAuth2Token :: ByteString -> Option 'Https
oAuth2Token ByteString
token =
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
attachHeader ByteString
"Authorization" (ByteString
"token " forall a. Semigroup a => a -> a -> a
<> ByteString
token))
customAuth :: (L.Request -> IO L.Request) -> Option scheme
customAuth :: forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth = forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
port :: Int -> Option scheme
port :: forall (scheme :: Scheme). Int -> Option scheme
port Int
n = forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {port :: Int
L.port = Int
n}
decompress ::
(ByteString -> Bool) ->
Option scheme
decompress :: forall (scheme :: Scheme). (ByteString -> Bool) -> Option scheme
decompress ByteString -> Bool
f = forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {decompress :: ByteString -> Bool
L.decompress = ByteString -> Bool
f}
responseTimeout ::
Int ->
Option scheme
responseTimeout :: forall (scheme :: Scheme). Int -> Option scheme
responseTimeout Int
n = forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {responseTimeout :: ResponseTimeout
L.responseTimeout = Int -> ResponseTimeout
LI.ResponseTimeoutMicro Int
n}
httpVersion ::
Int ->
Int ->
Option scheme
httpVersion :: forall (scheme :: Scheme). Int -> Int -> Option scheme
httpVersion Int
major Int
minor = forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {requestVersion :: HttpVersion
L.requestVersion = Int -> Int -> HttpVersion
Y.HttpVersion Int
major Int
minor}
newtype IgnoreResponse = IgnoreResponse (L.Response ())
deriving (Int -> IgnoreResponse -> ShowS
[IgnoreResponse] -> ShowS
IgnoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IgnoreResponse] -> ShowS
$cshowList :: [IgnoreResponse] -> ShowS
show :: IgnoreResponse -> String
$cshow :: IgnoreResponse -> String
showsPrec :: Int -> IgnoreResponse -> ShowS
$cshowsPrec :: Int -> IgnoreResponse -> ShowS
Show)
instance HttpResponse IgnoreResponse where
type HttpResponseBody IgnoreResponse = ()
toVanillaResponse :: IgnoreResponse -> Response (HttpResponseBody IgnoreResponse)
toVanillaResponse (IgnoreResponse Response ()
r) = Response ()
r
getHttpResponse :: Response BodyReader -> IO IgnoreResponse
getHttpResponse Response BodyReader
r = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Response () -> IgnoreResponse
IgnoreResponse (forall (f :: * -> *) a. Functor f => f a -> f ()
void Response BodyReader
r)
ignoreResponse :: Proxy IgnoreResponse
ignoreResponse :: Proxy IgnoreResponse
ignoreResponse = forall {k} (t :: k). Proxy t
Proxy
newtype JsonResponse a = JsonResponse (L.Response a)
deriving (Int -> JsonResponse a -> ShowS
forall a. Show a => Int -> JsonResponse a -> ShowS
forall a. Show a => [JsonResponse a] -> ShowS
forall a. Show a => JsonResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonResponse a] -> ShowS
$cshowList :: forall a. Show a => [JsonResponse a] -> ShowS
show :: JsonResponse a -> String
$cshow :: forall a. Show a => JsonResponse a -> String
showsPrec :: Int -> JsonResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> JsonResponse a -> ShowS
Show)
instance (FromJSON a) => HttpResponse (JsonResponse a) where
type HttpResponseBody (JsonResponse a) = a
toVanillaResponse :: JsonResponse a -> Response (HttpResponseBody (JsonResponse a))
toVanillaResponse (JsonResponse Response a
r) = Response a
r
getHttpResponse :: Response BodyReader -> IO (JsonResponse a)
getHttpResponse Response BodyReader
r = do
[ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (forall body. Response body -> body
L.responseBody Response BodyReader
r)
case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ([ByteString] -> ByteString
BL.fromChunks [ByteString]
chunks) of
Left String
e -> forall e a. Exception e => e -> IO a
throwIO (String -> HttpException
JsonHttpException String
e)
Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Response a -> JsonResponse a
JsonResponse (a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)
acceptHeader :: Proxy (JsonResponse a) -> Maybe ByteString
acceptHeader Proxy (JsonResponse a)
Proxy = forall a. a -> Maybe a
Just ByteString
"application/json"
jsonResponse :: Proxy (JsonResponse a)
jsonResponse :: forall a. Proxy (JsonResponse a)
jsonResponse = forall {k} (t :: k). Proxy t
Proxy
newtype BsResponse = BsResponse (L.Response ByteString)
deriving (Int -> BsResponse -> ShowS
[BsResponse] -> ShowS
BsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BsResponse] -> ShowS
$cshowList :: [BsResponse] -> ShowS
show :: BsResponse -> String
$cshow :: BsResponse -> String
showsPrec :: Int -> BsResponse -> ShowS
$cshowsPrec :: Int -> BsResponse -> ShowS
Show)
instance HttpResponse BsResponse where
type HttpResponseBody BsResponse = ByteString
toVanillaResponse :: BsResponse -> Response (HttpResponseBody BsResponse)
toVanillaResponse (BsResponse Response ByteString
r) = Response ByteString
r
getHttpResponse :: Response BodyReader -> IO BsResponse
getHttpResponse Response BodyReader
r = do
[ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (forall body. Response body -> body
L.responseBody Response BodyReader
r)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Response ByteString -> BsResponse
BsResponse ([ByteString] -> ByteString
B.concat [ByteString]
chunks forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)
bsResponse :: Proxy BsResponse
bsResponse :: Proxy BsResponse
bsResponse = forall {k} (t :: k). Proxy t
Proxy
newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
deriving (Int -> LbsResponse -> ShowS
[LbsResponse] -> ShowS
LbsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LbsResponse] -> ShowS
$cshowList :: [LbsResponse] -> ShowS
show :: LbsResponse -> String
$cshow :: LbsResponse -> String
showsPrec :: Int -> LbsResponse -> ShowS
$cshowsPrec :: Int -> LbsResponse -> ShowS
Show)
instance HttpResponse LbsResponse where
type HttpResponseBody LbsResponse = BL.ByteString
toVanillaResponse :: LbsResponse -> Response (HttpResponseBody LbsResponse)
toVanillaResponse (LbsResponse Response ByteString
r) = Response ByteString
r
getHttpResponse :: Response BodyReader -> IO LbsResponse
getHttpResponse Response BodyReader
r = do
[ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (forall body. Response body -> body
L.responseBody Response BodyReader
r)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Response ByteString -> LbsResponse
LbsResponse ([ByteString] -> ByteString
BL.fromChunks [ByteString]
chunks forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)
lbsResponse :: Proxy LbsResponse
lbsResponse :: Proxy LbsResponse
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 Int
nbytes Response BodyReader
r = do
let br :: BodyReader
br = forall body. Response body -> body
L.responseBody Response BodyReader
r
(ByteString
target, ByteString
leftover, Bool
done) <- BodyReader -> Int -> IO (ByteString, ByteString, Bool)
brReadN BodyReader
br Int
nbytes
IORef Int
nref <- forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int)
let br' :: BodyReader
br' = do
Int
n <- forall a. IORef a -> IO a
readIORef IORef Int
nref
let incn :: IO ()
incn = forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Int
nref (forall a. Num a => a -> a -> a
+ Int
1)
case Int
n of
Int
0 -> do
IO ()
incn
if ByteString -> Bool
B.null ByteString
target
then BodyReader
br'
else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
target
Int
1 -> do
IO ()
incn
if ByteString -> Bool
B.null ByteString
leftover
then BodyReader
br'
else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
leftover
Int
_ ->
if Bool
done
then forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
else BodyReader
br
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 BodyReader
br Int
n = Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go Int
0 forall a. a -> a
id forall a. a -> a
id
where
go :: Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go !Int
tlen [ByteString] -> [ByteString]
t [ByteString] -> [ByteString]
l = do
ByteString
chunk <- BodyReader
br
if ByteString -> Bool
B.null ByteString
chunk
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a}. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
t, forall {a}. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
l, Bool
True)
else do
let (ByteString
target, ByteString
leftover) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
n 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
target :)
l' :: [ByteString] -> [ByteString]
l' = [ByteString] -> [ByteString]
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
leftover :)
if Int
tlen forall a. Num a => a -> a -> a
+ Int
tlen' forall a. Ord a => a -> a -> Bool
< Int
n
then Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go (Int
tlen forall a. Num a => a -> a -> a
+ Int
tlen') [ByteString] -> [ByteString]
t' [ByteString] -> [ByteString]
l'
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a}. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
t', forall {a}. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
l', Bool
False)
r :: ([a] -> [ByteString]) -> ByteString
r [a] -> [ByteString]
f = [ByteString] -> ByteString
B.concat ([a] -> [ByteString]
f [])
responseBody ::
(HttpResponse response) =>
response ->
HttpResponseBody response
responseBody :: forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody = forall body. Response body -> body
L.responseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse
responseStatusCode ::
(HttpResponse response) =>
response ->
Int
responseStatusCode :: forall response. HttpResponse response => response -> Int
responseStatusCode =
Status -> Int
Y.statusCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> Status
L.responseStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse
responseStatusMessage ::
(HttpResponse response) =>
response ->
ByteString
responseStatusMessage :: forall response. HttpResponse response => response -> ByteString
responseStatusMessage =
Status -> ByteString
Y.statusMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> Status
L.responseStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse
responseHeader ::
(HttpResponse response) =>
response ->
ByteString ->
Maybe ByteString
response
r ByteString
h =
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall s. FoldCase s => s -> CI s
CI.mk ByteString
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> RequestHeaders
L.responseHeaders forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse) response
r
responseCookieJar ::
(HttpResponse response) =>
response ->
L.CookieJar
responseCookieJar :: forall response. HttpResponse response => response -> CookieJar
responseCookieJar = forall body. Response body -> CookieJar
L.responseCookieJar forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 response
Proxy = forall a. Maybe a
Nothing
instance HttpResponse (L.Response ()) where
type HttpResponseBody (L.Response ()) = ()
toVanillaResponse :: Response () -> Response (HttpResponseBody (Response ()))
toVanillaResponse = forall a. a -> a
id
getHttpResponse :: Response BodyReader -> IO (Response ())
getHttpResponse = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void
class RequestComponent a where
getRequestMod :: a -> Endo L.Request
newtype Tagged (tag :: Symbol) a = Tagged a
data HttpException
=
VanillaHttpException L.HttpException
|
JsonHttpException String
deriving (Int -> HttpException -> ShowS
[HttpException] -> ShowS
HttpException -> String
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. 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
isStatusCodeException :: HttpException -> Maybe (L.Response ())
isStatusCodeException :: HttpException -> Maybe (Response ())
isStatusCodeException
( VanillaHttpException
( L.HttpExceptionRequest
Request
_
(L.StatusCodeException Response ()
r ByteString
_)
)
) = forall a. a -> Maybe a
Just Response ()
r
isStatusCodeException HttpException
_ = forall a. Maybe a
Nothing
data CanHaveBody
=
CanHaveBody
|
NoBody
data Scheme
=
Http
|
Https
deriving (Scheme -> Scheme -> Bool
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
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
Ord, Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
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
Scheme -> DataType
Scheme -> Constr
(forall b. Data b => b -> b) -> Scheme -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Scheme -> m Exp
forall (m :: * -> *). Quote m => Scheme -> Code m Scheme
liftTyped :: forall (m :: * -> *). Quote m => Scheme -> Code m Scheme
$cliftTyped :: forall (m :: * -> *). Quote m => Scheme -> Code m Scheme
lift :: forall (m :: * -> *). Quote m => Scheme -> m Exp
$clift :: forall (m :: * -> *). Quote m => Scheme -> m Exp
TH.Lift)