{-# 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.Default.Class (def)
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 =
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> (Request -> m Request)
-> m response
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> (Request -> m Request)
-> m response
reqCb method
method Url scheme
url body
body Proxy response
responseProxy Option scheme
options Request -> m Request
forall a. a -> m a
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 =
method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m a)
-> m a
forall (m :: * -> *) method body (scheme :: Scheme) a.
(MonadHttp m, HttpMethod method, HttpBody body,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m a)
-> m a
req' method
method Url scheme
url body
body Option scheme
options ((Response BodyReader -> IO a) -> Request -> Manager -> m a
forall (m :: * -> *) b.
MonadHttp m =>
(Response BodyReader -> IO b) -> Request -> Manager -> m b
reqHandler Response BodyReader -> IO a
consume)
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 =
method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m response)
-> m response
forall (m :: * -> *) method body (scheme :: Scheme) a.
(MonadHttp m, HttpMethod method, HttpBody body,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Option scheme
-> (Request -> Manager -> m a)
-> m a
req' method
method Url scheme
url body
body (Option scheme
options Option scheme -> Option scheme -> Option scheme
forall a. Semigroup a => a -> a -> a
<> Option scheme
extraOptions) ((Request -> Manager -> m response) -> m response)
-> (Request -> Manager -> m response) -> m response
forall a b. (a -> b) -> a -> b
$ \Request
request Manager
manager -> do
Request
request' <- Request -> m Request
adjustRequest Request
request
(Response BodyReader -> IO response)
-> Request -> Manager -> m response
forall (m :: * -> *) b.
MonadHttp m =>
(Response BodyReader -> IO b) -> Request -> Manager -> m b
reqHandler Response BodyReader -> IO response
forall response.
HttpResponse response =>
Response BodyReader -> IO response
getHttpResponse Request
request' Manager
manager
where
extraOptions :: Option scheme
extraOptions =
case Proxy response -> Maybe ByteString
forall response.
HttpResponse response =>
Proxy response -> Maybe ByteString
acceptHeader Proxy response
responseProxy of
Maybe ByteString
Nothing -> Option scheme
forall a. Monoid a => a
mempty
Just ByteString
accept -> ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Accept" ByteString
accept
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 Manager
Maybe Proxy
RetryPolicyM IO
RetryStatus -> SomeException -> Bool
forall a. Num a => a
forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
forall b. RetryStatus -> Response b -> Bool
httpConfigProxy :: Maybe Proxy
httpConfigRedirectCount :: Int
httpConfigAltManager :: Maybe Manager
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool
httpConfigBodyPreviewLength :: forall a. Num a => a
httpConfigProxy :: HttpConfig -> Maybe Proxy
httpConfigRedirectCount :: HttpConfig -> Int
httpConfigAltManager :: HttpConfig -> Maybe Manager
httpConfigCheckResponse :: HttpConfig
-> forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigRetryPolicy :: HttpConfig -> RetryPolicyM IO
httpConfigRetryJudge :: HttpConfig -> forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudgeException :: HttpConfig -> RetryStatus -> SomeException -> Bool
httpConfigBodyPreviewLength :: HttpConfig -> forall a. Num a => a
..} <- m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
let wrapVanilla :: IO a -> IO a
wrapVanilla = (HttpException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (HttpException -> IO a
forall e a. Exception e => e -> IO a
throwIO (HttpException -> IO a)
-> (HttpException -> HttpException) -> HttpException -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> HttpException
VanillaHttpException)
wrapExc :: IO b -> IO b
wrapExc = (HttpExceptionContentWrapper -> IO b) -> IO b -> IO b
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (HttpException -> IO b
forall e a. Exception e => e -> IO a
throwIO (HttpException -> IO b)
-> (HttpExceptionContentWrapper -> HttpException)
-> HttpExceptionContentWrapper
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> HttpExceptionContentWrapper -> HttpException
LI.toHttpException Request
request)
withRRef :: (IORef (Maybe (Response a)) -> IO c) -> IO c
withRRef =
IO (IORef (Maybe (Response a)))
-> (IORef (Maybe (Response a)) -> IO ())
-> (IORef (Maybe (Response a)) -> IO c)
-> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(Maybe (Response a) -> IO (IORef (Maybe (Response a)))
forall a. a -> IO (IORef a)
newIORef Maybe (Response a)
forall a. Maybe a
Nothing)
(IORef (Maybe (Response a)) -> IO (Maybe (Response a))
forall a. IORef a -> IO a
readIORef (IORef (Maybe (Response a)) -> IO (Maybe (Response a)))
-> (Maybe (Response a) -> IO ())
-> IORef (Maybe (Response a))
-> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Response a -> IO ()) -> Maybe (Response a) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Response a -> IO ()
forall a. Response a -> IO ()
L.responseClose)
(IO (Either HttpException b) -> m (Either HttpException b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException b) -> m (Either HttpException b))
-> (IO b -> IO (Either HttpException b))
-> IO b
-> m (Either HttpException b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO (Either HttpException b)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO b -> IO (Either HttpException b))
-> (IO b -> IO b) -> IO b -> IO (Either HttpException b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO b
forall {a}. IO a -> IO a
wrapVanilla (IO b -> IO b) -> (IO b -> IO b) -> IO b -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO b
wrapExc)
( (IORef (Maybe (Response BodyReader)) -> IO b) -> IO b
forall {a} {c}. (IORef (Maybe (Response a)) -> IO c) -> IO c
withRRef ((IORef (Maybe (Response BodyReader)) -> IO b) -> IO b)
-> (IORef (Maybe (Response BodyReader)) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \IORef (Maybe (Response BodyReader))
rref -> do
let openResponse :: IO (Response BodyReader)
openResponse = IO (Response BodyReader) -> IO (Response BodyReader)
forall {a}. IO a -> IO a
mask_ (IO (Response BodyReader) -> IO (Response BodyReader))
-> IO (Response BodyReader) -> IO (Response BodyReader)
forall a b. (a -> b) -> a -> b
$ do
Maybe (Response BodyReader)
r <- IORef (Maybe (Response BodyReader))
-> IO (Maybe (Response BodyReader))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Response BodyReader))
rref
(Response BodyReader -> IO ())
-> Maybe (Response BodyReader) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Response BodyReader -> IO ()
forall a. Response a -> IO ()
L.responseClose Maybe (Response BodyReader)
r
Response BodyReader
r' <- Request -> Manager -> IO (Response BodyReader)
L.responseOpen Request
request Manager
manager
IORef (Maybe (Response BodyReader))
-> Maybe (Response BodyReader) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Response BodyReader))
rref (Response BodyReader -> Maybe (Response BodyReader)
forall a. a -> Maybe a
Just Response BodyReader
r')
Response BodyReader -> IO (Response BodyReader)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
r'
exceptionRetryPolicies :: [RetryStatus -> Handler IO Bool]
exceptionRetryPolicies =
[RetryStatus -> Handler IO Bool]
forall (m :: * -> *). MonadIO m => [RetryStatus -> Handler m Bool]
skipAsyncExceptions
[RetryStatus -> Handler IO Bool]
-> [RetryStatus -> Handler IO Bool]
-> [RetryStatus -> Handler IO Bool]
forall a. [a] -> [a] -> [a]
++ [ \RetryStatus
retryStatus -> (SomeException -> IO Bool) -> Handler IO Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((SomeException -> IO Bool) -> Handler IO Bool)
-> (SomeException -> IO Bool) -> Handler IO Bool
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ RetryStatus -> SomeException -> Bool
httpConfigRetryJudgeException RetryStatus
retryStatus SomeException
e
]
Response BodyReader
r <-
RetryPolicyM IO
-> (RetryStatus -> Response BodyReader -> IO Bool)
-> (RetryStatus -> IO (Response BodyReader))
-> IO (Response BodyReader)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying
RetryPolicyM IO
httpConfigRetryPolicy
(\RetryStatus
retryStatus Response BodyReader
r -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ RetryStatus -> Response BodyReader -> Bool
forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge RetryStatus
retryStatus Response BodyReader
r)
( IO (Response BodyReader) -> RetryStatus -> IO (Response BodyReader)
forall a b. a -> b -> a
const
( RetryPolicyM IO
-> [RetryStatus -> Handler IO Bool]
-> (RetryStatus -> IO (Response BodyReader))
-> IO (Response BodyReader)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering
RetryPolicyM IO
httpConfigRetryPolicy
[RetryStatus -> Handler IO Bool]
exceptionRetryPolicies
(IO (Response BodyReader) -> RetryStatus -> IO (Response BodyReader)
forall a b. a -> b -> a
const IO (Response BodyReader)
openResponse)
)
)
(ByteString
preview, Response BodyReader
r') <- Int -> Response BodyReader -> IO (ByteString, Response BodyReader)
grabPreview Int
forall a. Num a => a
httpConfigBodyPreviewLength Response BodyReader
r
(HttpExceptionContent -> IO Any)
-> Maybe HttpExceptionContent -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HttpExceptionContent -> IO Any
forall a. HttpExceptionContent -> IO a
LI.throwHttp (Request
-> Response BodyReader -> ByteString -> Maybe HttpExceptionContent
forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse Request
request Response BodyReader
r' ByteString
preview)
Response BodyReader -> IO b
consume Response BodyReader
r'
)
m (Either HttpException b)
-> (Either HttpException b -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HttpException -> m b)
-> (b -> m b) -> Either HttpException b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> m b
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
req' ::
forall m method body scheme a.
( MonadHttp m,
HttpMethod method,
HttpBody body,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
) =>
method ->
Url scheme ->
body ->
Option scheme ->
(L.Request -> L.Manager -> m a) ->
m a
req' :: 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 <- m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
let
nubHeaders :: Endo Request
nubHeaders = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x)}
request' :: Request
request' =
(Endo Request -> Request -> Request)
-> Request -> Endo Request -> Request
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo Request -> Request -> Request
forall a. Endo a -> a -> a
appEndo Request
L.defaultRequest (Endo Request -> Request) -> Endo Request -> Request
forall a b. (a -> b) -> a -> b
$
Endo Request
nubHeaders
Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> Option scheme -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod Option scheme
options
Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> HttpConfig -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod HttpConfig
config
Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> Tagged "body" body -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod (body -> Tagged "body" body
forall (tag :: Symbol) a. a -> Tagged tag a
Tagged body
body :: Tagged "body" body)
Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> Url scheme -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod Url scheme
url
Endo Request -> Endo Request -> Endo Request
forall a. Semigroup a => a -> a -> a
<> Tagged "method" method -> Endo Request
forall a. RequestComponent a => a -> Endo Request
getRequestMod (method -> Tagged "method" method
forall (tag :: Symbol) a. a -> Tagged tag a
Tagged method
method :: Tagged "method" method)
Request
request <- Option scheme -> Request -> m Request
forall (m :: * -> *) (scheme :: Scheme).
MonadIO m =>
Option scheme -> Request -> m Request
finalizeRequest Option scheme
options Request
request'
(Manager -> m a) -> m a
forall (m :: * -> *) a. MonadIO m => (Manager -> m a) -> m a
withReqManager (Request -> Manager -> m a
m Request
request)
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 = IO Manager -> m Manager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Manager -> IO Manager
forall a. IORef a -> IO a
readIORef IORef Manager
globalManager) m Manager -> (Manager -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> m a
m
globalManager :: IORef L.Manager
globalManager :: IORef Manager
globalManager = IO (IORef Manager) -> IORef Manager
forall a. IO a -> a
unsafePerformIO (IO (IORef Manager) -> IORef Manager)
-> IO (IORef Manager) -> IORef Manager
forall a b. (a -> b) -> a -> b
$ do
ConnectionContext
context <- IO ConnectionContext
NC.initConnectionContext
let settings :: ManagerSettings
settings =
Maybe ConnectionContext
-> TLSSettings -> Maybe SockSettings -> ManagerSettings
L.mkManagerSettingsContext
(ConnectionContext -> Maybe ConnectionContext
forall a. a -> Maybe a
Just ConnectionContext
context)
(Bool -> Bool -> Bool -> Supported -> TLSSettings
NC.TLSSettingsSimple Bool
False Bool
False Bool
False Supported
forall a. Default a => a
def)
Maybe SockSettings
forall a. Maybe a
Nothing
Manager
manager <- ManagerSettings -> IO Manager
L.newManager ManagerSettings
settings
Manager -> IO (IORef Manager)
forall a. a -> IO (IORef a)
newIORef Manager
manager
{-# NOINLINE globalManager #-}
class (MonadIO m) => MonadHttp m where
handleHttpException :: HttpException -> m a
getHttpConfig :: m HttpConfig
getHttpConfig = HttpConfig -> m HttpConfig
forall a. a -> m a
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 = Maybe Proxy
forall a. Maybe a
Nothing,
httpConfigRedirectCount :: Int
httpConfigRedirectCount = Int
10,
httpConfigAltManager :: Maybe Manager
httpConfigAltManager = Maybe Manager
forall a. Maybe a
Nothing,
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigCheckResponse = \Request
_ Response b
response ByteString
preview ->
let scode :: Int
scode = Response b -> Int
forall {body}. Response body -> Int
statusCode Response b
response
in if Int
200 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
scode Bool -> Bool -> Bool
&& Int
scode Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300
then Maybe HttpExceptionContent
forall a. Maybe a
Nothing
else HttpExceptionContent -> Maybe HttpExceptionContent
forall a. a -> Maybe a
Just (Response () -> ByteString -> HttpExceptionContent
L.StatusCodeException (Response b -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response b
response) ByteString
preview),
httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigRetryPolicy = RetryPolicyM IO
forall (m :: * -> *). Monad m => RetryPolicyM m
retryPolicyDefault,
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudge = \RetryStatus
_ Response b
response ->
Response b -> Int
forall {body}. Response body -> Int
statusCode Response b
response
Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (L.HttpExceptionRequest Request
_ HttpExceptionContent
c) ->
case HttpExceptionContent
c of
HttpExceptionContent
L.ResponseTimeout -> Bool
True
HttpExceptionContent
L.ConnectionTimeout -> Bool
True
HttpExceptionContent
_ -> Bool
False
Maybe HttpException
_ -> Bool
False,
httpConfigBodyPreviewLength :: forall a. Num a => a
httpConfigBodyPreviewLength = a
forall a. Num a => a
1024
}
where
statusCode :: Response body -> Int
statusCode = Status -> Int
Y.statusCode (Status -> Int)
-> (Response body -> Status) -> Response body -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response body -> Status
forall body. Response body -> Status
L.responseStatus
instance RequestComponent HttpConfig where
getRequestMod :: HttpConfig -> Endo Request
getRequestMod HttpConfig {Int
Maybe Manager
Maybe Proxy
RetryPolicyM IO
RetryStatus -> SomeException -> Bool
forall a. Num a => a
forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
forall b. RetryStatus -> Response b -> Bool
httpConfigProxy :: HttpConfig -> Maybe Proxy
httpConfigRedirectCount :: HttpConfig -> Int
httpConfigAltManager :: HttpConfig -> Maybe Manager
httpConfigCheckResponse :: HttpConfig
-> forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigRetryPolicy :: HttpConfig -> RetryPolicyM IO
httpConfigRetryJudge :: HttpConfig -> forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudgeException :: HttpConfig -> RetryStatus -> SomeException -> Bool
httpConfigBodyPreviewLength :: HttpConfig -> forall a. Num a => a
httpConfigProxy :: Maybe Proxy
httpConfigRedirectCount :: Int
httpConfigAltManager :: Maybe Manager
httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
httpConfigRetryPolicy :: RetryPolicyM IO
httpConfigRetryJudge :: forall b. RetryStatus -> Response b -> Bool
httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool
httpConfigBodyPreviewLength :: forall a. Num a => a
..} = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x
{ L.proxy = httpConfigProxy,
L.redirectCount = httpConfigRedirectCount,
LI.requestManagerOverride = httpConfigAltManager
}
newtype Req a = Req (ReaderT HttpConfig IO a)
deriving
( (forall a b. (a -> b) -> Req a -> Req b)
-> (forall a b. a -> Req b -> Req a) -> Functor Req
forall a b. a -> Req b -> Req a
forall a b. (a -> b) -> Req a -> Req b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Req a -> Req b
fmap :: forall a b. (a -> b) -> Req a -> Req b
$c<$ :: forall a b. a -> Req b -> Req a
<$ :: forall a b. a -> Req b -> Req a
Functor,
Functor Req
Functor Req =>
(forall a. a -> Req a)
-> (forall a b. Req (a -> b) -> Req a -> Req b)
-> (forall a b c. (a -> b -> c) -> Req a -> Req b -> Req c)
-> (forall a b. Req a -> Req b -> Req b)
-> (forall a b. Req a -> Req b -> Req a)
-> Applicative Req
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
$cpure :: forall a. a -> Req a
pure :: forall a. a -> Req a
$c<*> :: forall a b. Req (a -> b) -> Req a -> Req b
<*> :: forall a b. Req (a -> b) -> Req a -> Req b
$cliftA2 :: forall a b c. (a -> b -> c) -> Req a -> Req b -> Req c
liftA2 :: forall a b c. (a -> b -> c) -> Req a -> Req b -> Req c
$c*> :: forall a b. Req a -> Req b -> Req b
*> :: forall a b. Req a -> Req b -> Req b
$c<* :: forall a b. Req a -> Req b -> Req a
<* :: forall a b. Req a -> Req b -> Req a
Applicative,
Applicative Req
Applicative Req =>
(forall a b. Req a -> (a -> Req b) -> Req b)
-> (forall a b. Req a -> Req b -> Req b)
-> (forall a. a -> Req a)
-> Monad Req
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
$c>>= :: forall a b. Req a -> (a -> Req b) -> Req b
>>= :: forall a b. Req a -> (a -> Req b) -> Req b
$c>> :: forall a b. Req a -> Req b -> Req b
>> :: forall a b. Req a -> Req b -> Req b
$creturn :: forall a. a -> Req a
return :: forall a. a -> Req a
Monad,
Monad Req
Monad Req => (forall a. IO a -> Req a) -> MonadIO Req
forall a. IO a -> Req a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Req a
liftIO :: forall a. IO a -> Req a
MonadIO,
MonadIO Req
MonadIO Req =>
(forall b. ((forall a. Req a -> IO a) -> IO b) -> Req b)
-> MonadUnliftIO 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
$cwithRunInIO :: forall b. ((forall a. Req a -> IO a) -> IO b) -> Req b
withRunInIO :: 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 = IO α -> Req α
forall a. IO a -> Req a
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 = ReaderT HttpConfig IO a -> Req a
forall a. ReaderT HttpConfig IO a -> Req a
Req (ReaderT HttpConfig IO a -> Req a)
-> ((HttpConfig -> IO a) -> ReaderT HttpConfig IO a)
-> (HttpConfig -> IO a)
-> Req a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpConfig -> IO a) -> ReaderT HttpConfig IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((HttpConfig -> IO a) -> Req a) -> (HttpConfig -> IO a) -> Req a
forall a b. (a -> b) -> a -> b
$ \HttpConfig
r -> RunInBase Req IO -> IO a
f (HttpConfig -> Req a -> IO a
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
r)
{-# INLINEABLE liftBaseWith #-}
restoreM :: forall a. StM Req a -> Req a
restoreM = ReaderT HttpConfig IO a -> Req a
forall a. ReaderT HttpConfig IO a -> Req a
Req (ReaderT HttpConfig IO a -> Req a)
-> (a -> ReaderT HttpConfig IO a) -> a -> Req a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpConfig -> IO a) -> ReaderT HttpConfig IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((HttpConfig -> IO a) -> ReaderT HttpConfig IO a)
-> (a -> HttpConfig -> IO a) -> a -> ReaderT HttpConfig IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> HttpConfig -> IO a
forall a b. a -> b -> a
const (IO a -> HttpConfig -> IO a)
-> (a -> IO a) -> a -> HttpConfig -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINEABLE restoreM #-}
instance MonadHttp Req where
handleHttpException :: forall a. HttpException -> Req a
handleHttpException = ReaderT HttpConfig IO a -> Req a
forall a. ReaderT HttpConfig IO a -> Req a
Req (ReaderT HttpConfig IO a -> Req a)
-> (HttpException -> ReaderT HttpConfig IO a)
-> HttpException
-> Req a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT HttpConfig IO a
forall (m :: * -> *) a. Monad m => m a -> ReaderT HttpConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> ReaderT HttpConfig IO a)
-> (HttpException -> IO a)
-> HttpException
-> ReaderT HttpConfig IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> IO a
forall e a. Exception e => e -> IO a
throwIO
getHttpConfig :: Req HttpConfig
getHttpConfig = ReaderT HttpConfig IO HttpConfig -> Req HttpConfig
forall a. ReaderT HttpConfig IO a -> Req a
Req ReaderT HttpConfig IO HttpConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where
handleHttpException :: forall a. HttpException -> AccumT w m a
handleHttpException = m a -> AccumT w m a
forall (m :: * -> *) a. Monad m => m a -> AccumT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AccumT w m a)
-> (HttpException -> m a) -> HttpException -> AccumT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: AccumT w m HttpConfig
getHttpConfig = m HttpConfig -> AccumT w m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> AccumT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (ContT r m) where
handleHttpException :: forall a. HttpException -> ContT r m a
handleHttpException = m a -> ContT r m a
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContT r m a)
-> (HttpException -> m a) -> HttpException -> ContT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: ContT r m HttpConfig
getHttpConfig = m HttpConfig -> ContT r m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (ExceptT e m) where
handleHttpException :: forall a. HttpException -> ExceptT e m a
handleHttpException = m a -> ExceptT e m a
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e m a)
-> (HttpException -> m a) -> HttpException -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: ExceptT e m HttpConfig
getHttpConfig = m HttpConfig -> ExceptT e m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (IdentityT m) where
handleHttpException :: forall a. HttpException -> IdentityT m a
handleHttpException = m a -> IdentityT m a
forall (m :: * -> *) a. Monad m => m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a)
-> (HttpException -> m a) -> HttpException -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: IdentityT m HttpConfig
getHttpConfig = m HttpConfig -> IdentityT m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (MaybeT m) where
handleHttpException :: forall a. HttpException -> MaybeT m a
handleHttpException = m a -> MaybeT m a
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MaybeT m a)
-> (HttpException -> m a) -> HttpException -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: MaybeT m HttpConfig
getHttpConfig = m HttpConfig -> MaybeT m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (ReaderT r m) where
handleHttpException :: forall a. HttpException -> ReaderT r m a
handleHttpException = m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (HttpException -> m a) -> HttpException -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: ReaderT r m HttpConfig
getHttpConfig = m HttpConfig -> ReaderT r m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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 = m a -> RWST r w s m a
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (HttpException -> m a) -> HttpException -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = m HttpConfig -> RWST r w s m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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 = m a -> RWST r w s m a
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (HttpException -> m a) -> HttpException -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = m HttpConfig -> RWST r w s m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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 = m a -> RWST r w s m a
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> (HttpException -> m a) -> HttpException -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: RWST r w s m HttpConfig
getHttpConfig = m HttpConfig -> RWST r w s m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
forall (m :: * -> *). MonadHttp m => m HttpConfig
getHttpConfig
instance (MonadHttp m) => MonadHttp (SelectT r m) where
handleHttpException :: forall a. HttpException -> SelectT r m a
handleHttpException = m a -> SelectT r m a
forall (m :: * -> *) a. Monad m => m a -> SelectT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> SelectT r m a)
-> (HttpException -> m a) -> HttpException -> SelectT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: SelectT r m HttpConfig
getHttpConfig = m HttpConfig -> SelectT r m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> SelectT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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 = m a -> StateT s m a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (HttpException -> m a) -> HttpException -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: StateT s m HttpConfig
getHttpConfig = m HttpConfig -> StateT s m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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 = m a -> StateT s m a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (HttpException -> m a) -> HttpException -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: StateT s m HttpConfig
getHttpConfig = m HttpConfig -> StateT s m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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 = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (HttpException -> m a) -> HttpException -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = m HttpConfig -> WriterT w m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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 = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (HttpException -> m a) -> HttpException -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = m HttpConfig -> WriterT w m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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 = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (HttpException -> m a) -> HttpException -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> m a
forall a. HttpException -> m a
forall (m :: * -> *) a. MonadHttp m => HttpException -> m a
handleHttpException
getHttpConfig :: WriterT w m HttpConfig
getHttpConfig = m HttpConfig -> WriterT w m HttpConfig
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HttpConfig
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) = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT HttpConfig IO a -> HttpConfig -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT HttpConfig IO a
m HttpConfig
config)
data GET = GET
instance HttpMethod GET where
type AllowsBody GET = 'NoBody
httpMethodName :: Proxy GET -> ByteString
httpMethodName Proxy 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
_ = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {L.method = httpMethodName (Proxy :: Proxy method)}
data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
deriving (Url scheme -> Url scheme -> Bool
(Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Bool) -> Eq (Url scheme)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
$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
Eq, Eq (Url scheme)
Eq (Url scheme) =>
(Url scheme -> Url scheme -> Ordering)
-> (Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Bool)
-> (Url scheme -> Url scheme -> Url scheme)
-> (Url scheme -> Url scheme -> Url scheme)
-> Ord (Url scheme)
Url scheme -> Url scheme -> Bool
Url scheme -> Url scheme -> Ordering
Url scheme -> Url scheme -> Url scheme
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (scheme :: Scheme). Eq (Url scheme)
forall (scheme :: Scheme). Url scheme -> Url scheme -> Bool
forall (scheme :: Scheme). Url scheme -> Url scheme -> Ordering
forall (scheme :: Scheme). Url scheme -> Url scheme -> Url scheme
$ccompare :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Ordering
compare :: Url scheme -> Url scheme -> Ordering
$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
>= :: Url scheme -> Url scheme -> Bool
$cmax :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Url scheme
max :: Url scheme -> Url scheme -> Url scheme
$cmin :: forall (scheme :: Scheme). Url scheme -> Url scheme -> Url scheme
min :: Url scheme -> Url scheme -> Url scheme
Ord, Int -> Url scheme -> ShowS
[Url scheme] -> ShowS
Url scheme -> String
(Int -> Url scheme -> ShowS)
-> (Url scheme -> String)
-> ([Url scheme] -> ShowS)
-> Show (Url scheme)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (scheme :: Scheme). Int -> Url scheme -> ShowS
forall (scheme :: Scheme). [Url scheme] -> ShowS
forall (scheme :: Scheme). Url scheme -> String
$cshowsPrec :: forall (scheme :: Scheme). Int -> Url scheme -> ShowS
showsPrec :: Int -> Url scheme -> ShowS
$cshow :: forall (scheme :: Scheme). Url scheme -> String
show :: Url scheme -> String
$cshowList :: forall (scheme :: Scheme). [Url scheme] -> ShowS
showList :: [Url scheme] -> ShowS
Show, Typeable (Url scheme)
Typeable (Url scheme) =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme))
-> (Url scheme -> Constr)
-> (Url scheme -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Url scheme)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme)))
-> ((forall b. Data b => b -> b) -> Url scheme -> Url scheme)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r)
-> (forall u. (forall d. Data d => d -> u) -> Url scheme -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Url scheme -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme))
-> Data (Url scheme)
Url scheme -> Constr
Url scheme -> DataType
(forall b. Data b => b -> b) -> Url scheme -> Url scheme
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Url scheme -> u
forall u. (forall d. Data d => d -> u) -> Url scheme -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall (scheme :: Scheme). Typeable scheme => Typeable (Url scheme)
forall (scheme :: Scheme). Typeable scheme => Url scheme -> Constr
forall (scheme :: Scheme).
Typeable scheme =>
Url scheme -> DataType
forall (scheme :: Scheme).
Typeable scheme =>
(forall b. Data b => b -> b) -> Url scheme -> Url scheme
forall (scheme :: Scheme) u.
Typeable scheme =>
Int -> (forall d. Data d => d -> u) -> Url scheme -> u
forall (scheme :: Scheme) u.
Typeable scheme =>
(forall d. Data d => d -> u) -> Url scheme -> [u]
forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, Monad m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (scheme :: Scheme) (c :: * -> *).
Typeable scheme =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
forall (scheme :: Scheme) (c :: * -> *).
Typeable scheme =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme)
forall (scheme :: Scheme) (t :: * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url scheme))
forall (scheme :: Scheme) (t :: * -> * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme))
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> c (Url scheme)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Url scheme))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme))
$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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url scheme -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url scheme)
$ctoConstr :: forall (scheme :: Scheme). Typeable scheme => Url scheme -> Constr
toConstr :: Url scheme -> Constr
$cdataTypeOf :: forall (scheme :: Scheme).
Typeable scheme =>
Url scheme -> DataType
dataTypeOf :: Url scheme -> DataType
$cdataCast1 :: forall (scheme :: Scheme) (t :: * -> *) (c :: * -> *).
(Typeable scheme, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url scheme))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url scheme))
$cgmapT :: forall (scheme :: Scheme).
Typeable scheme =>
(forall b. Data b => b -> b) -> Url scheme -> Url scheme
gmapT :: (forall b. Data b => b -> b) -> Url scheme -> Url scheme
$cgmapQl :: 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
$cgmapQr :: forall (scheme :: Scheme) r r'.
Typeable scheme =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url scheme -> r
$cgmapQ :: forall (scheme :: Scheme) u.
Typeable scheme =>
(forall d. Data d => d -> u) -> Url scheme -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Url scheme -> u
$cgmapM :: forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, Monad 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)
$cgmapMp :: 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)
$cgmapMo :: forall (scheme :: Scheme) (m :: * -> *).
(Typeable scheme, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Url scheme -> m (Url scheme)
Data, Typeable, (forall x. Url scheme -> Rep (Url scheme) x)
-> (forall x. Rep (Url scheme) x -> Url scheme)
-> Generic (Url scheme)
forall x. Rep (Url scheme) x -> Url scheme
forall x. Url scheme -> Rep (Url scheme) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (scheme :: Scheme) x. Rep (Url scheme) x -> Url scheme
forall (scheme :: Scheme) x. Url scheme -> Rep (Url scheme) x
$cfrom :: forall (scheme :: Scheme) x. Url scheme -> Rep (Url scheme) x
from :: forall x. Url scheme -> Rep (Url scheme) x
$cto :: forall (scheme :: Scheme) x. Rep (Url scheme) x -> Url scheme
to :: forall x. Rep (Url scheme) x -> Url scheme
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 b. Data b => b -> Maybe (m Exp)) -> Url scheme -> m Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
TH.dataToExpQ ((Text -> m Exp) -> Maybe Text -> Maybe (m Exp)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> m Exp
forall {f :: * -> *}. Quote f => Text -> f Exp
liftText (Maybe Text -> Maybe (m Exp))
-> (b -> Maybe Text) -> b -> Maybe (m Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe Text
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast) Url scheme
url m Exp -> m Type -> m Exp
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) (Exp -> Exp) -> f Exp -> f Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.lift (Text -> String
T.unpack Text
t)
liftTyped :: forall (m :: * -> *). Quote m => Url scheme -> Code m (Url scheme)
liftTyped = m (TExp (Url scheme)) -> Code m (Url scheme)
forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code (m (TExp (Url scheme)) -> Code m (Url scheme))
-> (Url scheme -> m (TExp (Url scheme)))
-> Url scheme
-> Code m (Url scheme)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Exp -> m (TExp (Url scheme))
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
TH.unsafeTExpCoerce (m Exp -> m (TExp (Url scheme)))
-> (Url scheme -> m Exp) -> Url scheme -> m (TExp (Url scheme))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Url scheme -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Url scheme -> m Exp
TH.lift
http :: Text -> Url 'Http
http :: Text -> Url 'Http
http = Scheme -> NonEmpty Text -> Url 'Http
forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
Http (NonEmpty Text -> Url 'Http)
-> (Text -> NonEmpty Text) -> Text -> Url 'Http
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
https :: Text -> Url 'Https
https :: Text -> Url 'Https
https = Scheme -> NonEmpty Text -> Url 'Https
forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
Https (NonEmpty Text -> Url 'Https)
-> (Text -> NonEmpty Text) -> Text -> Url 'Https
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NonEmpty Text
forall a. a -> NonEmpty a
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 = Scheme -> NonEmpty Text -> Url scheme
forall (scheme :: Scheme). Scheme -> NonEmpty Text -> Url scheme
Url Scheme
secure (Text -> NonEmpty Text -> NonEmpty Text
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece a
segment) NonEmpty Text
path)
infixl 5 /:
(/:) :: Url scheme -> Text -> Url scheme
/: :: forall (scheme :: Scheme). Url scheme -> Text -> Url 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://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> Text
renderParts NonEmpty Text
parts
Url Scheme
Http NonEmpty Text
parts ->
Text
"http://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> Text
renderParts NonEmpty Text
parts
where
renderParts :: NonEmpty Text -> Text
renderParts NonEmpty Text
parts =
Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
parts)
useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)
useHttpURI :: forall (scheme :: Scheme). URI -> Maybe (Url 'Http, Option scheme)
useHttpURI URI
uri = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri Maybe (RText 'Scheme) -> Maybe (RText 'Scheme) -> Bool
forall a. Eq a => a -> a -> Bool
== RText 'Scheme -> Maybe (RText 'Scheme)
forall a. a -> Maybe a
Just [QQ.scheme|http|])
Url 'Http
urlHead <- Text -> Url 'Http
http (Text -> Url 'Http) -> Maybe Text -> Maybe (Url 'Http)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe Text
uriHost URI
uri
let url :: Url 'Http
url = case URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
URI.uriPath URI
uri of
Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing -> Url 'Http
urlHead
Just (Bool, NonEmpty (RText 'PathPiece))
uriPath -> (Bool, NonEmpty (RText 'PathPiece)) -> Url 'Http -> Url 'Http
forall (scheme :: Scheme).
(Bool, NonEmpty (RText 'PathPiece)) -> Url scheme -> Url scheme
uriPathToUrl (Bool, NonEmpty (RText 'PathPiece))
uriPath Url 'Http
urlHead
(Url 'Http, Option scheme) -> Maybe (Url 'Http, Option scheme)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Url 'Http
url, URI -> Option scheme
forall (scheme :: Scheme). URI -> Option scheme
uriOptions URI
uri)
useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI :: forall (scheme :: Scheme). URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI URI
uri = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (URI -> Maybe (RText 'Scheme)
URI.uriScheme URI
uri Maybe (RText 'Scheme) -> Maybe (RText 'Scheme) -> Bool
forall a. Eq a => a -> a -> Bool
== RText 'Scheme -> Maybe (RText 'Scheme)
forall a. a -> Maybe a
Just [QQ.scheme|https|])
Url 'Https
urlHead <- Text -> Url 'Https
https (Text -> Url 'Https) -> Maybe Text -> Maybe (Url 'Https)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe Text
uriHost URI
uri
let url :: Url 'Https
url = case URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
URI.uriPath URI
uri of
Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing -> Url 'Https
urlHead
Just (Bool, NonEmpty (RText 'PathPiece))
uriPath -> (Bool, NonEmpty (RText 'PathPiece)) -> Url 'Https -> Url 'Https
forall (scheme :: Scheme).
(Bool, NonEmpty (RText 'PathPiece)) -> Url scheme -> Url scheme
uriPathToUrl (Bool, NonEmpty (RText 'PathPiece))
uriPath Url 'Https
urlHead
(Url 'Https, Option scheme) -> Maybe (Url 'Https, Option scheme)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Url 'Https
url, URI -> Option scheme
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 Url scheme -> Text -> Url scheme
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
T.empty else Url scheme
path
where
path :: Url scheme
path = (Url scheme -> Text -> Url scheme)
-> Url scheme -> [Text] -> Url scheme
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Url scheme -> Text -> Url scheme
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
(/:) Url scheme
urlHead (RText 'PathPiece -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText (RText 'PathPiece -> Text) -> [RText 'PathPiece] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (RText 'PathPiece) -> [RText 'PathPiece]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (RText 'PathPiece)
xs)
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 =
((Url 'Http, Option scheme0)
-> Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1)
forall a b. a -> Either a b
Left ((Url 'Http, Option scheme0)
-> Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
-> Maybe (Url 'Http, Option scheme0)
-> Maybe
(Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe (Url 'Http, Option scheme0)
forall (scheme :: Scheme). URI -> Maybe (Url 'Http, Option scheme)
useHttpURI URI
uri) Maybe
(Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
-> Maybe
(Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
-> Maybe
(Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Url 'Https, Option scheme1)
-> Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1)
forall a b. b -> Either a b
Right ((Url 'Https, Option scheme1)
-> Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
-> Maybe (Url 'Https, Option scheme1)
-> Maybe
(Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe (Url 'Https, Option scheme1)
forall (scheme :: Scheme). URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI URI
uri)
uriHost :: URI -> Maybe Text
uriHost :: URI -> Maybe Text
uriHost URI
uri = case URI -> Either Bool Authority
URI.uriAuthority URI
uri of
Left Bool
_ -> Maybe Text
forall a. Maybe a
Nothing
Right URI.Authority {Maybe Word
Maybe UserInfo
RText 'Host
authUserInfo :: Maybe UserInfo
authHost :: RText 'Host
authPort :: Maybe Word
authUserInfo :: Authority -> Maybe UserInfo
authHost :: Authority -> RText 'Host
authPort :: Authority -> Maybe Word
..} ->
Text -> Maybe Text
forall a. a -> Maybe a
Just (RText 'Host -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'Host
authHost)
urlQ :: TH.QuasiQuoter
urlQ :: QuasiQuoter
urlQ =
TH.QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = \String
str ->
case Text -> Either SomeException URI
forall (m :: * -> *). MonadThrow m => Text -> m URI
URI.mkURI (String -> Text
T.pack String
str) of
Left SomeException
err -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
err)
Right URI
uri -> case URI
-> Maybe (Either (Url 'Http, Option Any) (Url 'Https, Option Any))
forall (scheme0 :: Scheme) (scheme1 :: Scheme).
URI
-> Maybe
(Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
useURI URI
uri of
Maybe (Either (Url 'Http, Option Any) (Url 'Https, Option Any))
Nothing -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a HTTP or HTTPS URL"
Just Either (Url 'Http, Option Any) (Url 'Https, Option Any)
eurl ->
[Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.tupE
[ ((Url 'Http, Option Any) -> Q Exp)
-> ((Url 'Https, Option Any) -> Q Exp)
-> Either (Url 'Http, Option Any) (Url 'Https, Option Any)
-> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Url 'Http -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Url 'Http -> m Exp
TH.lift (Url 'Http -> Q Exp)
-> ((Url 'Http, Option Any) -> Url 'Http)
-> (Url 'Http, Option Any)
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Url 'Http, Option Any) -> Url 'Http
forall a b. (a, b) -> a
fst) (Url 'Https -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Url 'Https -> m Exp
TH.lift (Url 'Https -> Q Exp)
-> ((Url 'Https, Option Any) -> Url 'Https)
-> (Url 'Https, Option Any)
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Url 'Https, Option Any) -> Url 'Https
forall a b. (a, b) -> a
fst) Either (Url 'Http, Option Any) (Url 'Https, Option Any)
eurl,
[|uriOptions uri|]
],
quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"This usage is not supported",
quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"This usage is not supported",
quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"This usage is not supported"
}
uriOptions :: forall scheme. URI -> Option scheme
uriOptions :: forall (scheme :: Scheme). URI -> Option scheme
uriOptions URI
uri =
[Option scheme] -> Option scheme
forall a. Monoid a => [a] -> a
mconcat
[ Option scheme
auth,
Option scheme
query,
Option scheme
port'
]
where
(Option scheme
auth, Option scheme
port') =
case URI -> Either Bool Authority
URI.uriAuthority URI
uri of
Left Bool
_ -> (Option scheme
forall a. Monoid a => a
mempty, Option scheme
forall a. Monoid a => a
mempty)
Right URI.Authority {Maybe Word
Maybe UserInfo
RText 'Host
authUserInfo :: Authority -> Maybe UserInfo
authHost :: Authority -> RText 'Host
authPort :: Authority -> Maybe Word
authUserInfo :: Maybe UserInfo
authHost :: RText 'Host
authPort :: Maybe Word
..} ->
let auth0 :: Option scheme
auth0 = case Maybe UserInfo
authUserInfo of
Maybe UserInfo
Nothing -> Option scheme
forall a. Monoid a => a
mempty
Just URI.UserInfo {Maybe (RText 'Password)
RText 'Username
uiUsername :: RText 'Username
uiPassword :: Maybe (RText 'Password)
uiUsername :: UserInfo -> RText 'Username
uiPassword :: UserInfo -> Maybe (RText 'Password)
..} ->
let username :: ByteString
username = Text -> ByteString
T.encodeUtf8 (RText 'Username -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'Username
uiUsername)
password :: ByteString
password = ByteString
-> (RText 'Password -> ByteString)
-> Maybe (RText 'Password)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (Text -> ByteString
T.encodeUtf8 (Text -> ByteString)
-> (RText 'Password -> Text) -> RText 'Password -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText 'Password -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText) Maybe (RText 'Password)
uiPassword
in ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe ByteString
username ByteString
password
port0 :: Option scheme
port0 = case Maybe Word
authPort of
Maybe Word
Nothing -> Option scheme
forall a. Monoid a => a
mempty
Just Word
port'' -> Int -> Option scheme
forall (scheme :: Scheme). Int -> Option scheme
port (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
port'')
in (Option scheme
auth0, Option scheme
port0)
query :: Option scheme
query =
let liftQueryParam :: QueryParam -> Option scheme
liftQueryParam = \case
URI.QueryFlag RText 'QueryKey
t -> Text -> Option scheme
forall param. QueryParam param => Text -> param
queryFlag (RText 'QueryKey -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryKey
t)
URI.QueryParam RText 'QueryKey
k RText 'QueryValue
v -> RText 'QueryKey -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryKey
k Text -> Text -> Option scheme
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: RText 'QueryValue -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText RText 'QueryValue
v
in [Option scheme] -> Option scheme
forall a. Monoid a => [a] -> a
mconcat (QueryParam -> Option scheme
liftQueryParam (QueryParam -> Option scheme) -> [QueryParam] -> [Option scheme]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> [QueryParam]
URI.uriQuery URI
uri)
instance RequestComponent (Url scheme) where
getRequestMod :: Url scheme -> Endo Request
getRequestMod (Url Scheme
scheme NonEmpty Text
segments) = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
let (Text
host :| [Text]
path) = NonEmpty Text -> NonEmpty Text
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty Text
segments
in Request
x
{ L.secure = case scheme of
Scheme
Http -> Bool
False
Scheme
Https -> Bool
True,
L.port = case scheme of
Scheme
Http -> Int
80
Scheme
Https -> Int
443,
L.host = Y.urlEncode False (T.encodeUtf8 host),
L.path =
(BL.toStrict . BB.toLazyByteString . Y.encodePathSegments) 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 (a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
a)
getRequestContentType :: ReqBodyJson a -> Maybe ByteString
getRequestContentType ReqBodyJson a
_ = ByteString -> Maybe ByteString
forall a. a -> Maybe 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 (ByteString -> RequestBody)
-> (Builder -> ByteString) -> Builder -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString) (Bool -> [(Text, Maybe Text)] -> Builder
Y.renderQueryText Bool
False [(Text, Maybe Text)]
params)
getRequestContentType :: ReqBodyUrlEnc -> Maybe ByteString
getRequestContentType ReqBodyUrlEnc
_ = ByteString -> Maybe ByteString
forall a. a -> Maybe a
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
(FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam)
-> (NonEmpty FormUrlEncodedParam -> FormUrlEncodedParam)
-> (forall b.
Integral b =>
b -> FormUrlEncodedParam -> FormUrlEncodedParam)
-> Semigroup FormUrlEncodedParam
forall b.
Integral b =>
b -> FormUrlEncodedParam -> FormUrlEncodedParam
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
<> :: FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
$csconcat :: NonEmpty FormUrlEncodedParam -> FormUrlEncodedParam
sconcat :: NonEmpty FormUrlEncodedParam -> FormUrlEncodedParam
$cstimes :: forall b.
Integral b =>
b -> FormUrlEncodedParam -> FormUrlEncodedParam
stimes :: forall b.
Integral b =>
b -> FormUrlEncodedParam -> FormUrlEncodedParam
Semigroup, Semigroup FormUrlEncodedParam
FormUrlEncodedParam
Semigroup FormUrlEncodedParam =>
FormUrlEncodedParam
-> (FormUrlEncodedParam
-> FormUrlEncodedParam -> FormUrlEncodedParam)
-> ([FormUrlEncodedParam] -> FormUrlEncodedParam)
-> Monoid FormUrlEncodedParam
[FormUrlEncodedParam] -> FormUrlEncodedParam
FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: FormUrlEncodedParam
mempty :: FormUrlEncodedParam
$cmappend :: FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
mappend :: FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
$cmconcat :: [FormUrlEncodedParam] -> FormUrlEncodedParam
mconcat :: [FormUrlEncodedParam] -> 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, a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (a -> Text) -> Maybe a -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mvalue)]
queryParamToList :: FormUrlEncodedParam -> [(Text, Maybe Text)]
queryParamToList (FormUrlEncodedParam [(Text, Maybe Text)]
p) = [(Text, Maybe Text)]
p
instance FromForm FormUrlEncodedParam where
fromForm :: Form -> Either Text FormUrlEncodedParam
fromForm = FormUrlEncodedParam -> Either Text FormUrlEncodedParam
forall a b. b -> Either a b
Right (FormUrlEncodedParam -> Either Text FormUrlEncodedParam)
-> (Form -> FormUrlEncodedParam)
-> Form
-> Either Text FormUrlEncodedParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> FormUrlEncodedParam
forall param f.
(QueryParam param, Monoid param, ToForm f) =>
f -> param
formToQuery
data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody
instance HttpBody ReqBodyMultipart where
getRequestBody :: ReqBodyMultipart -> RequestBody
getRequestBody (ReqBodyMultipart ByteString
_ RequestBody
body) = RequestBody
body
getRequestContentType :: ReqBodyMultipart -> Maybe ByteString
getRequestContentType (ReqBodyMultipart ByteString
boundary RequestBody
_) =
ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
"multipart/form-data; boundary=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
boundary)
reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart
reqBodyMultipart :: forall (m :: * -> *). MonadIO m => [Part] -> m ReqBodyMultipart
reqBodyMultipart [Part]
parts = IO ReqBodyMultipart -> m ReqBodyMultipart
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReqBodyMultipart -> m ReqBodyMultipart)
-> IO ReqBodyMultipart -> m ReqBodyMultipart
forall a b. (a -> b) -> a -> b
$ do
ByteString
boundary <- BodyReader
LM.webkitBoundary
RequestBody
body <- ByteString -> [Part] -> IO RequestBody
forall (m :: * -> *).
Applicative m =>
ByteString -> [PartM m] -> m RequestBody
LM.renderParts ByteString
boundary [Part]
parts
ReqBodyMultipart -> IO ReqBodyMultipart
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> RequestBody -> ReqBodyMultipart
ReqBodyMultipart ByteString
boundary RequestBody
body)
class HttpBody body where
getRequestBody :: body -> L.RequestBody
getRequestContentType :: body -> Maybe ByteString
getRequestContentType = Maybe ByteString -> body -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing
type family ProvidesBody body :: CanHaveBody where
ProvidesBody NoReqBody = 'NoBody
ProvidesBody body = 'CanHaveBody
type family
HttpBodyAllowed
(allowsBody :: CanHaveBody)
(providesBody :: CanHaveBody) ::
Constraint
where
HttpBodyAllowed 'NoBody 'NoBody = ()
HttpBodyAllowed 'CanHaveBody body = ()
HttpBodyAllowed 'NoBody 'CanHaveBody =
TypeError
('Text "This HTTP method does not allow attaching a request body.")
instance (HttpBody body) => RequestComponent (Tagged "body" body) where
getRequestMod :: Tagged "body" body -> Endo Request
getRequestMod (Tagged body
body) = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x
{ L.requestBody = getRequestBody body,
L.requestHeaders =
let old = Request -> [Header]
L.requestHeaders Request
x
in case getRequestContentType body of
Maybe ByteString
Nothing -> [Header]
old
Just ByteString
contentType ->
(HeaderName
Y.hContentType, ByteString
contentType) Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
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 =
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option
(Endo ([(Text, Maybe Text)], Request)
er0 Endo ([(Text, Maybe Text)], Request)
-> Endo ([(Text, Maybe Text)], Request)
-> Endo ([(Text, Maybe Text)], Request)
forall a. Semigroup a => a -> a -> a
<> Endo ([(Text, Maybe Text)], Request)
er1)
(Maybe (Request -> IO Request)
mr0 Maybe (Request -> IO Request)
-> Maybe (Request -> IO Request) -> Maybe (Request -> IO Request)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Request -> IO Request)
mr1)
instance Monoid (Option scheme) where
mempty :: Option scheme
mempty = Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option Endo ([(Text, Maybe Text)], Request)
forall a. Monoid a => a
mempty Maybe (Request -> IO Request)
forall a. Maybe a
Nothing
mappend :: Option scheme -> Option scheme -> Option scheme
mappend = Option scheme -> Option scheme -> Option scheme
forall a. Semigroup a => a -> a -> a
(<>)
instance FromForm (Option scheme) where
fromForm :: Form -> Either Text (Option scheme)
fromForm = Option scheme -> Either Text (Option scheme)
forall a b. b -> Either a b
Right (Option scheme -> Either Text (Option scheme))
-> (Form -> Option scheme) -> Form -> Either Text (Option scheme)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> Option scheme
forall param f.
(QueryParam param, Monoid param, ToForm f) =>
f -> param
formToQuery
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 = Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option ((([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request))
-> Endo ([(Text, Maybe Text)], Request)
forall a. (a -> a) -> Endo a
Endo (([(Text, Maybe Text)] -> [(Text, Maybe Text)])
-> ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [(Text, Maybe Text)] -> [(Text, Maybe Text)]
f)) Maybe (Request -> IO Request)
forall a. Maybe a
Nothing
withRequest :: (L.Request -> L.Request) -> Option scheme
withRequest :: forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest Request -> Request
f = Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option ((([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request))
-> Endo ([(Text, Maybe Text)], Request)
forall a. (a -> a) -> Endo a
Endo ((Request -> Request)
-> ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Request -> Request
f)) Maybe (Request -> IO Request)
forall a. Maybe a
Nothing
instance RequestComponent (Option scheme) where
getRequestMod :: Option scheme -> Endo Request
getRequestMod (Option Endo ([(Text, Maybe Text)], Request)
f Maybe (Request -> IO Request)
_) = (Request -> Request) -> Endo Request
forall a. (a -> a) -> Endo a
Endo ((Request -> Request) -> Endo Request)
-> (Request -> Request) -> Endo Request
forall a b. (a -> b) -> a -> b
$ \Request
x ->
let ([(Text, Maybe Text)]
qparams, Request
x') = Endo ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
forall a. Endo a -> a -> a
appEndo Endo ([(Text, Maybe Text)], Request)
f ([], Request
x)
query :: ByteString
query = Bool -> Query -> ByteString
Y.renderQuery Bool
True ([(Text, Maybe Text)] -> Query
Y.queryTextToQuery [(Text, Maybe Text)]
qparams)
in Request
x' {L.queryString = 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) = IO Request -> m Request
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> m Request)
-> (Request -> IO Request) -> Request -> m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> IO Request)
-> Maybe (Request -> IO Request) -> Request -> IO Request
forall a. a -> Maybe a -> a
fromMaybe Request -> IO Request
forall a. a -> IO a
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 = Text -> Maybe a -> param
forall a. ToHttpApiData a => Text -> Maybe a -> param
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
name (a -> Maybe a
forall a. a -> Maybe a
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 = Text -> Maybe () -> param
forall a. ToHttpApiData a => Text -> Maybe a -> param
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
name (Maybe ()
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 = [param] -> param
forall a. Monoid a => [a] -> a
mconcat ([param] -> param) -> (Form -> [param]) -> Form -> param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> param) -> [(Text, Text)] -> [param]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> param
forall {param} {a}.
(QueryParam param, ToHttpApiData a, Eq a, IsString a) =>
(Text, a) -> param
toParam ([(Text, Text)] -> [param])
-> (Form -> [(Text, Text)]) -> Form -> [param]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> [(Text, Text)]
Form.toListStable (Form -> param) -> Form -> param
forall a b. (a -> b) -> a -> b
$ f -> Form
forall a. ToForm a => a -> Form
toForm f
f
where
toParam :: (Text, a) -> param
toParam (Text
key, a
val) =
Text -> Maybe a -> param
forall a. ToHttpApiData a => Text -> Maybe a -> param
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> Maybe a -> param
queryParam Text
key (Maybe a -> param) -> Maybe a -> param
forall a b. (a -> b) -> a -> b
$
if a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
""
then Maybe a
forall a. Maybe a
Nothing
else a -> Maybe a
forall a. a -> Maybe a
Just a
val
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 =
([(Text, Maybe Text)] -> [(Text, Maybe Text)]) -> Option scheme
forall (scheme :: Scheme).
([(Text, Maybe Text)] -> [(Text, Maybe Text)]) -> Option scheme
withQueryParams ((:) (Text
name, a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (a -> Text) -> Maybe a -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mvalue))
queryParamToList :: Option scheme -> [(Text, Maybe Text)]
queryParamToList (Option Endo ([(Text, Maybe Text)], Request)
f Maybe (Request -> IO Request)
_) = ([(Text, Maybe Text)], Request) -> [(Text, Maybe Text)]
forall a b. (a, b) -> a
fst (([(Text, Maybe Text)], Request) -> [(Text, Maybe Text)])
-> ([(Text, Maybe Text)], Request) -> [(Text, Maybe Text)]
forall a b. (a -> b) -> a -> b
$ Endo ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
-> ([(Text, Maybe Text)], Request)
forall a. Endo a -> a -> a
appEndo Endo ([(Text, Maybe Text)], Request)
f ([], Request
L.defaultRequest)
header ::
ByteString ->
ByteString ->
Option scheme
ByteString
name ByteString
value = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest (ByteString -> ByteString -> Request -> Request
attachHeader ByteString
name ByteString
value)
attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
ByteString
name ByteString
value Request
x =
Request
x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
headerRedacted :: ByteString -> ByteString -> Option scheme
ByteString
name ByteString
value = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
let y :: Request
y = ByteString -> ByteString -> Request -> Request
attachHeader ByteString
name ByteString
value Request
x
in Request
y {L.redactHeaders = CI.mk name `S.insert` L.redactHeaders y}
cookieJar :: L.CookieJar -> Option scheme
cookieJar :: forall (scheme :: Scheme). CookieJar -> Option scheme
cookieJar CookieJar
jar = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {L.cookieJar = Just jar}
basicAuth ::
ByteString ->
ByteString ->
Option 'Https
basicAuth :: ByteString -> ByteString -> Option 'Https
basicAuth = ByteString -> ByteString -> Option 'Https
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe
basicAuthUnsafe ::
ByteString ->
ByteString ->
Option scheme
basicAuthUnsafe :: forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicAuthUnsafe ByteString
username ByteString
password =
(Request -> IO Request) -> Option scheme
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
(Request -> IO Request
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> IO Request)
-> (Request -> Request) -> Request -> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
L.applyBasicAuth ByteString
username ByteString
password)
basicProxyAuth ::
ByteString ->
ByteString ->
Option scheme
basicProxyAuth :: forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
basicProxyAuth ByteString
username ByteString
password =
(Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest (ByteString -> ByteString -> Request -> Request
L.applyBasicProxyAuth ByteString
username ByteString
password)
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 =
(Request -> IO Request) -> Option scheme
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth (OAuth -> Credential -> Request -> IO Request
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m Request
OAuth.signOAuth OAuth
app Credential
creds)
where
app :: OAuth
app =
OAuth
OAuth.newOAuth
{ OAuth.oauthConsumerKey = consumerToken,
OAuth.oauthConsumerSecret = consumerSecret
}
creds :: Credential
creds = ByteString -> ByteString -> Credential
OAuth.newCredential ByteString
token ByteString
tokenSecret
oAuth2Bearer ::
ByteString ->
Option 'Https
oAuth2Bearer :: ByteString -> Option 'Https
oAuth2Bearer ByteString
token =
(Request -> IO Request) -> Option 'Https
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
(Request -> IO Request
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> IO Request)
-> (Request -> Request) -> Request -> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
attachHeader ByteString
"Authorization" (ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
token))
oAuth2Token ::
ByteString ->
Option 'Https
oAuth2Token :: ByteString -> Option 'Https
oAuth2Token ByteString
token =
(Request -> IO Request) -> Option 'Https
forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth
(Request -> IO Request
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> IO Request)
-> (Request -> Request) -> Request -> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Request
attachHeader ByteString
"Authorization" (ByteString
"token " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
token))
customAuth :: (L.Request -> IO L.Request) -> Option scheme
customAuth :: forall (scheme :: Scheme). (Request -> IO Request) -> Option scheme
customAuth = Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
forall (scheme :: Scheme).
Endo ([(Text, Maybe Text)], Request)
-> Maybe (Request -> IO Request) -> Option scheme
Option Endo ([(Text, Maybe Text)], Request)
forall a. Monoid a => a
mempty (Maybe (Request -> IO Request) -> Option scheme)
-> ((Request -> IO Request) -> Maybe (Request -> IO Request))
-> (Request -> IO Request)
-> Option scheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> IO Request) -> Maybe (Request -> IO Request)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
port :: Int -> Option scheme
port :: forall (scheme :: Scheme). Int -> Option scheme
port Int
n = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {L.port = n}
decompress ::
(ByteString -> Bool) ->
Option scheme
decompress :: forall (scheme :: Scheme). (ByteString -> Bool) -> Option scheme
decompress ByteString -> Bool
f = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {L.decompress = f}
responseTimeout ::
Int ->
Option scheme
responseTimeout :: forall (scheme :: Scheme). Int -> Option scheme
responseTimeout Int
n = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {L.responseTimeout = LI.ResponseTimeoutMicro n}
httpVersion ::
Int ->
Int ->
Option scheme
httpVersion :: forall (scheme :: Scheme). Int -> Int -> Option scheme
httpVersion Int
major Int
minor = (Request -> Request) -> Option scheme
forall (scheme :: Scheme). (Request -> Request) -> Option scheme
withRequest ((Request -> Request) -> Option scheme)
-> (Request -> Request) -> Option scheme
forall a b. (a -> b) -> a -> b
$ \Request
x ->
Request
x {L.requestVersion = Y.HttpVersion major minor}
newtype IgnoreResponse = IgnoreResponse (L.Response ())
deriving (Int -> IgnoreResponse -> ShowS
[IgnoreResponse] -> ShowS
IgnoreResponse -> String
(Int -> IgnoreResponse -> ShowS)
-> (IgnoreResponse -> String)
-> ([IgnoreResponse] -> ShowS)
-> Show IgnoreResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IgnoreResponse -> ShowS
showsPrec :: Int -> IgnoreResponse -> ShowS
$cshow :: IgnoreResponse -> String
show :: IgnoreResponse -> String
$cshowList :: [IgnoreResponse] -> ShowS
showList :: [IgnoreResponse] -> ShowS
Show)
instance HttpResponse IgnoreResponse where
type HttpResponseBody IgnoreResponse = ()
toVanillaResponse :: IgnoreResponse -> Response (HttpResponseBody IgnoreResponse)
toVanillaResponse (IgnoreResponse Response ()
r) = Response ()
Response (HttpResponseBody IgnoreResponse)
r
getHttpResponse :: Response BodyReader -> IO IgnoreResponse
getHttpResponse Response BodyReader
r = IgnoreResponse -> IO IgnoreResponse
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IgnoreResponse -> IO IgnoreResponse)
-> IgnoreResponse -> IO IgnoreResponse
forall a b. (a -> b) -> a -> b
$ Response () -> IgnoreResponse
IgnoreResponse (Response BodyReader -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response BodyReader
r)
ignoreResponse :: Proxy IgnoreResponse
ignoreResponse :: Proxy IgnoreResponse
ignoreResponse = Proxy IgnoreResponse
forall {k} (t :: k). Proxy t
Proxy
newtype JsonResponse a = JsonResponse (L.Response a)
deriving (Int -> JsonResponse a -> ShowS
[JsonResponse a] -> ShowS
JsonResponse a -> String
(Int -> JsonResponse a -> ShowS)
-> (JsonResponse a -> String)
-> ([JsonResponse a] -> ShowS)
-> Show (JsonResponse a)
forall a. Show a => Int -> JsonResponse a -> ShowS
forall a. Show a => [JsonResponse a] -> ShowS
forall a. Show a => JsonResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> JsonResponse a -> ShowS
showsPrec :: Int -> JsonResponse a -> ShowS
$cshow :: forall a. Show a => JsonResponse a -> String
show :: JsonResponse a -> String
$cshowList :: forall a. Show a => [JsonResponse a] -> ShowS
showList :: [JsonResponse a] -> ShowS
Show)
instance (FromJSON a) => HttpResponse (JsonResponse a) where
type HttpResponseBody (JsonResponse a) = a
toVanillaResponse :: JsonResponse a -> Response (HttpResponseBody (JsonResponse a))
toVanillaResponse (JsonResponse Response a
r) = Response a
Response (HttpResponseBody (JsonResponse a))
r
getHttpResponse :: Response BodyReader -> IO (JsonResponse a)
getHttpResponse Response BodyReader
r = do
[ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r)
case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ([ByteString] -> ByteString
BL.fromChunks [ByteString]
chunks) of
Left String
e -> HttpException -> IO (JsonResponse a)
forall e a. Exception e => e -> IO a
throwIO (String -> HttpException
JsonHttpException String
e)
Right a
x -> JsonResponse a -> IO (JsonResponse a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (JsonResponse a -> IO (JsonResponse a))
-> JsonResponse a -> IO (JsonResponse a)
forall a b. (a -> b) -> a -> b
$ Response a -> JsonResponse a
forall a. Response a -> JsonResponse a
JsonResponse (a
x a -> Response BodyReader -> Response a
forall a b. a -> Response b -> Response a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)
acceptHeader :: Proxy (JsonResponse a) -> Maybe ByteString
acceptHeader Proxy (JsonResponse a)
Proxy = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"application/json"
jsonResponse :: Proxy (JsonResponse a)
jsonResponse :: forall a. Proxy (JsonResponse a)
jsonResponse = Proxy (JsonResponse a)
forall {k} (t :: k). Proxy t
Proxy
newtype BsResponse = BsResponse (L.Response ByteString)
deriving (Int -> BsResponse -> ShowS
[BsResponse] -> ShowS
BsResponse -> String
(Int -> BsResponse -> ShowS)
-> (BsResponse -> String)
-> ([BsResponse] -> ShowS)
-> Show BsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BsResponse -> ShowS
showsPrec :: Int -> BsResponse -> ShowS
$cshow :: BsResponse -> String
show :: BsResponse -> String
$cshowList :: [BsResponse] -> ShowS
showList :: [BsResponse] -> ShowS
Show)
instance HttpResponse BsResponse where
type HttpResponseBody BsResponse = ByteString
toVanillaResponse :: BsResponse -> Response (HttpResponseBody BsResponse)
toVanillaResponse (BsResponse Response ByteString
r) = Response ByteString
Response (HttpResponseBody BsResponse)
r
getHttpResponse :: Response BodyReader -> IO BsResponse
getHttpResponse Response BodyReader
r = do
[ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r)
BsResponse -> IO BsResponse
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BsResponse -> IO BsResponse) -> BsResponse -> IO BsResponse
forall a b. (a -> b) -> a -> b
$ Response ByteString -> BsResponse
BsResponse ([ByteString] -> ByteString
B.concat [ByteString]
chunks ByteString -> Response BodyReader -> Response ByteString
forall a b. a -> Response b -> Response a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)
bsResponse :: Proxy BsResponse
bsResponse :: Proxy BsResponse
bsResponse = Proxy BsResponse
forall {k} (t :: k). Proxy t
Proxy
newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
deriving (Int -> LbsResponse -> ShowS
[LbsResponse] -> ShowS
LbsResponse -> String
(Int -> LbsResponse -> ShowS)
-> (LbsResponse -> String)
-> ([LbsResponse] -> ShowS)
-> Show LbsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LbsResponse -> ShowS
showsPrec :: Int -> LbsResponse -> ShowS
$cshow :: LbsResponse -> String
show :: LbsResponse -> String
$cshowList :: [LbsResponse] -> ShowS
showList :: [LbsResponse] -> ShowS
Show)
instance HttpResponse LbsResponse where
type HttpResponseBody LbsResponse = BL.ByteString
toVanillaResponse :: LbsResponse -> Response (HttpResponseBody LbsResponse)
toVanillaResponse (LbsResponse Response ByteString
r) = Response ByteString
Response (HttpResponseBody LbsResponse)
r
getHttpResponse :: Response BodyReader -> IO LbsResponse
getHttpResponse Response BodyReader
r = do
[ByteString]
chunks <- BodyReader -> IO [ByteString]
L.brConsume (Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r)
LbsResponse -> IO LbsResponse
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LbsResponse -> IO LbsResponse) -> LbsResponse -> IO LbsResponse
forall a b. (a -> b) -> a -> b
$ Response ByteString -> LbsResponse
LbsResponse ([ByteString] -> ByteString
BL.fromChunks [ByteString]
chunks ByteString -> Response BodyReader -> Response ByteString
forall a b. a -> Response b -> Response a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
r)
lbsResponse :: Proxy LbsResponse
lbsResponse :: Proxy LbsResponse
lbsResponse = Proxy LbsResponse
forall {k} (t :: k). Proxy t
Proxy
grabPreview ::
Int ->
L.Response L.BodyReader ->
IO (ByteString, L.Response L.BodyReader)
grabPreview :: Int -> Response BodyReader -> IO (ByteString, Response BodyReader)
grabPreview Int
nbytes Response BodyReader
r = do
let br :: BodyReader
br = Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody Response BodyReader
r
(ByteString
target, ByteString
leftover, Bool
done) <- BodyReader -> Int -> IO (ByteString, ByteString, Bool)
brReadN BodyReader
br Int
nbytes
IORef Int
nref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int)
let br' :: BodyReader
br' = do
Int
n <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
nref
let incn :: IO ()
incn = IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Int
nref (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
case Int
n of
Int
0 -> do
IO ()
incn
if ByteString -> Bool
B.null ByteString
target
then BodyReader
br'
else ByteString -> BodyReader
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
target
Int
1 -> do
IO ()
incn
if ByteString -> Bool
B.null ByteString
leftover
then BodyReader
br'
else ByteString -> BodyReader
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
leftover
Int
_ ->
if Bool
done
then ByteString -> BodyReader
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
else BodyReader
br
(ByteString, Response BodyReader)
-> IO (ByteString, Response BodyReader)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
target, Response BodyReader
r {L.responseBody = 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 [ByteString] -> [ByteString]
forall a. a -> a
id [ByteString] -> [ByteString]
forall a. a -> a
id
where
go :: Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go !Int
tlen [ByteString] -> [ByteString]
t [ByteString] -> [ByteString]
l = do
ByteString
chunk <- BodyReader
br
if ByteString -> Bool
B.null ByteString
chunk
then (ByteString, ByteString, Bool) -> IO (ByteString, ByteString, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([ByteString] -> [ByteString]) -> ByteString
forall {a}. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
t, ([ByteString] -> [ByteString]) -> ByteString
forall {a}. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
l, Bool
True)
else do
let (ByteString
target, ByteString
leftover) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tlen) ByteString
chunk
tlen' :: Int
tlen' = ByteString -> Int
B.length ByteString
target
t' :: [ByteString] -> [ByteString]
t' = [ByteString] -> [ByteString]
t ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
target :)
l' :: [ByteString] -> [ByteString]
l' = [ByteString] -> [ByteString]
l ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
leftover :)
if Int
tlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tlen' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
then Int
-> ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString])
-> IO (ByteString, ByteString, Bool)
go (Int
tlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tlen') [ByteString] -> [ByteString]
t' [ByteString] -> [ByteString]
l'
else (ByteString, ByteString, Bool) -> IO (ByteString, ByteString, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([ByteString] -> [ByteString]) -> ByteString
forall {a}. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
t', ([ByteString] -> [ByteString]) -> ByteString
forall {a}. ([a] -> [ByteString]) -> ByteString
r [ByteString] -> [ByteString]
l', Bool
False)
r :: ([a] -> [ByteString]) -> ByteString
r [a] -> [ByteString]
f = [ByteString] -> ByteString
B.concat ([a] -> [ByteString]
f [])
responseBody ::
(HttpResponse response) =>
response ->
HttpResponseBody response
responseBody :: forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody = Response (HttpResponseBody response) -> HttpResponseBody response
forall body. Response body -> body
L.responseBody (Response (HttpResponseBody response) -> HttpResponseBody response)
-> (response -> Response (HttpResponseBody response))
-> response
-> HttpResponseBody response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse
responseStatusCode ::
(HttpResponse response) =>
response ->
Int
responseStatusCode :: forall response. HttpResponse response => response -> Int
responseStatusCode =
Status -> Int
Y.statusCode (Status -> Int) -> (response -> Status) -> response -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (HttpResponseBody response) -> Status
forall body. Response body -> Status
L.responseStatus (Response (HttpResponseBody response) -> Status)
-> (response -> Response (HttpResponseBody response))
-> response
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse
responseStatusMessage ::
(HttpResponse response) =>
response ->
ByteString
responseStatusMessage :: forall response. HttpResponse response => response -> ByteString
responseStatusMessage =
Status -> ByteString
Y.statusMessage (Status -> ByteString)
-> (response -> Status) -> response -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (HttpResponseBody response) -> Status
forall body. Response body -> Status
L.responseStatus (Response (HttpResponseBody response) -> Status)
-> (response -> Response (HttpResponseBody response))
-> response
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse
responseHeader ::
(HttpResponse response) =>
response ->
ByteString ->
Maybe ByteString
response
r ByteString
h =
(HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk ByteString
h) ([Header] -> Maybe ByteString)
-> (response -> [Header]) -> response -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (HttpResponseBody response) -> [Header]
forall body. Response body -> [Header]
L.responseHeaders (Response (HttpResponseBody response) -> [Header])
-> (response -> Response (HttpResponseBody response))
-> response
-> [Header]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse) response
r
responseCookieJar ::
(HttpResponse response) =>
response ->
L.CookieJar
responseCookieJar :: forall response. HttpResponse response => response -> CookieJar
responseCookieJar = Response (HttpResponseBody response) -> CookieJar
forall body. Response body -> CookieJar
L.responseCookieJar (Response (HttpResponseBody response) -> CookieJar)
-> (response -> Response (HttpResponseBody response))
-> response
-> CookieJar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. response -> Response (HttpResponseBody response)
forall response.
HttpResponse response =>
response -> Response (HttpResponseBody response)
toVanillaResponse
class HttpResponse response where
type HttpResponseBody response :: Type
toVanillaResponse :: response -> L.Response (HttpResponseBody response)
getHttpResponse ::
L.Response L.BodyReader ->
IO response
:: Proxy response -> Maybe ByteString
acceptHeader Proxy response
Proxy = Maybe ByteString
forall a. Maybe a
Nothing
instance HttpResponse (L.Response ()) where
type HttpResponseBody (L.Response ()) = ()
toVanillaResponse :: Response () -> Response (HttpResponseBody (Response ()))
toVanillaResponse = Response () -> Response ()
Response () -> Response (HttpResponseBody (Response ()))
forall a. a -> a
id
getHttpResponse :: Response BodyReader -> IO (Response ())
getHttpResponse = Response () -> IO (Response ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response () -> IO (Response ()))
-> (Response BodyReader -> Response ())
-> Response BodyReader
-> IO (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
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
(Int -> HttpException -> ShowS)
-> (HttpException -> String)
-> ([HttpException] -> ShowS)
-> Show HttpException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HttpException -> ShowS
showsPrec :: Int -> HttpException -> ShowS
$cshow :: HttpException -> String
show :: HttpException -> String
$cshowList :: [HttpException] -> ShowS
showList :: [HttpException] -> ShowS
Show, Typeable, (forall x. HttpException -> Rep HttpException x)
-> (forall x. Rep HttpException x -> HttpException)
-> Generic HttpException
forall x. Rep HttpException x -> HttpException
forall x. HttpException -> Rep HttpException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HttpException -> Rep HttpException x
from :: forall x. HttpException -> Rep HttpException x
$cto :: forall x. Rep HttpException x -> HttpException
to :: forall x. Rep HttpException x -> HttpException
Generic)
instance Exception HttpException
isStatusCodeException :: HttpException -> Maybe (L.Response ())
isStatusCodeException :: HttpException -> Maybe (Response ())
isStatusCodeException
( VanillaHttpException
( L.HttpExceptionRequest
Request
_
(L.StatusCodeException Response ()
r ByteString
_)
)
) = Response () -> Maybe (Response ())
forall a. a -> Maybe a
Just Response ()
r
isStatusCodeException HttpException
_ = Maybe (Response ())
forall a. Maybe a
Nothing
data CanHaveBody
=
CanHaveBody
|
NoBody
data Scheme
=
Http
|
Https
deriving (Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
/= :: Scheme -> Scheme -> Bool
Eq, Eq Scheme
Eq Scheme =>
(Scheme -> Scheme -> Ordering)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Scheme)
-> (Scheme -> Scheme -> Scheme)
-> Ord Scheme
Scheme -> Scheme -> Bool
Scheme -> Scheme -> Ordering
Scheme -> Scheme -> Scheme
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scheme -> Scheme -> Ordering
compare :: Scheme -> Scheme -> Ordering
$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
>= :: Scheme -> Scheme -> Bool
$cmax :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
min :: Scheme -> Scheme -> Scheme
Ord, Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scheme -> ShowS
showsPrec :: Int -> Scheme -> ShowS
$cshow :: Scheme -> String
show :: Scheme -> String
$cshowList :: [Scheme] -> ShowS
showList :: [Scheme] -> ShowS
Show, Typeable Scheme
Typeable Scheme =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme)
-> (Scheme -> Constr)
-> (Scheme -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme))
-> ((forall b. Data b => b -> b) -> Scheme -> Scheme)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Scheme -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Scheme -> r)
-> (forall u. (forall d. Data d => d -> u) -> Scheme -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme)
-> Data Scheme
Scheme -> Constr
Scheme -> DataType
(forall b. Data b => b -> b) -> Scheme -> Scheme
forall 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scheme -> c Scheme
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scheme
$ctoConstr :: Scheme -> Constr
toConstr :: Scheme -> Constr
$cdataTypeOf :: Scheme -> DataType
dataTypeOf :: Scheme -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scheme)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scheme)
$cgmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
gmapT :: (forall b. Data b => b -> b) -> Scheme -> Scheme
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scheme -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Scheme -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scheme -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scheme -> m Scheme
Data, Typeable, (forall x. Scheme -> Rep Scheme x)
-> (forall x. Rep Scheme x -> Scheme) -> Generic Scheme
forall x. Rep Scheme x -> Scheme
forall x. Scheme -> Rep Scheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Scheme -> Rep Scheme x
from :: forall x. Scheme -> Rep Scheme x
$cto :: forall x. Rep Scheme x -> Scheme
to :: forall x. Rep Scheme x -> Scheme
Generic, (forall (m :: * -> *). Quote m => Scheme -> m Exp)
-> (forall (m :: * -> *). Quote m => Scheme -> Code m Scheme)
-> Lift Scheme
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
$clift :: forall (m :: * -> *). Quote m => Scheme -> m Exp
lift :: forall (m :: * -> *). Quote m => Scheme -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Scheme -> Code m Scheme
liftTyped :: forall (m :: * -> *). Quote m => Scheme -> Code m Scheme
TH.Lift)