{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Network.HTTP.Req.OAuth2.Internal.Util
( acceptLanguage
, evalOAuth2
, hasResponseStatus
, oAuth2AuthHeader
, oAuth2BearerHeader
, oAuth2PostRaw
, runOAuth2
) where
import Control.Monad.Trans.State.Strict (evalStateT, runStateT)
import Data.Aeson (Value)
import qualified Data.ByteString as ByteString (append, concat)
import qualified Data.ByteString.Base64 as Base64 (encode)
import qualified Data.Text.Encoding as Text (encodeUtf8)
import qualified Network.HTTP.Client as HTTP (HttpException(..), HttpExceptionContent(..), responseStatus)
import Network.HTTP.Req
( FormUrlEncodedParam
, HttpException(..)
, Option
, POST(..)
, ReqBodyUrlEnc(..)
, Scheme(..)
, Url
, defaultHttpConfig
, header
, jsonResponse
, oAuth2Bearer
, req
, responseBody
, runReq
)
import Network.HTTP.Req.OAuth2.Internal.Types
import Network.HTTP.Types (Status)
hasResponseStatus :: HttpException -> Status -> Bool
hasResponseStatus :: HttpException -> Status -> Bool
hasResponseStatus
(VanillaHttpException (HTTP.HttpExceptionRequest Request
_ (HTTP.StatusCodeException Response ()
response ByteString
_))) Status
status =
Response () -> Status
forall body. Response body -> Status
HTTP.responseStatus Response ()
response Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status
hasResponseStatus HttpException
_ Status
_ = Bool
False
acceptLanguage :: Option scheme
acceptLanguage :: Option scheme
acceptLanguage = ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Accept-Language" ByteString
"en_US"
oAuth2AuthHeader :: ClientPair -> Option scheme
ClientPair
clientPair =
ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"Authorization" (ByteString -> ByteString -> ByteString
ByteString.append ByteString
"Basic " (ClientPair -> ByteString
encodeClientAuth ClientPair
clientPair))
where
encodeClientAuth :: ClientPair -> ByteString
encodeClientAuth (ClientPair (ClientId Text
cid) (ClientSecret Text
cs)) = ByteString -> ByteString
Base64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
ByteString.concat [Text -> ByteString
Text.encodeUtf8 Text
cid, ByteString
":", Text -> ByteString
Text.encodeUtf8 Text
cs]
oAuth2BearerHeader :: AccessToken -> Option 'Https
(AccessToken Text
at) = ByteString -> Option 'Https
oAuth2Bearer (Text -> ByteString
Text.encodeUtf8 Text
at)
oAuth2PostRaw :: Url 'Https -> Option 'Https -> FormUrlEncodedParam -> IO Value
oAuth2PostRaw :: Url 'Https -> Option 'Https -> FormUrlEncodedParam -> IO Value
oAuth2PostRaw Url 'Https
url Option 'Https
opts FormUrlEncodedParam
formBody =
HttpConfig -> Req Value -> IO Value
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req Value -> IO Value) -> Req Value -> IO Value
forall a b. (a -> b) -> a -> b
$
JsonResponse Value -> Value
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody (JsonResponse Value -> Value)
-> Req (JsonResponse Value) -> Req Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> POST
-> Url 'Https
-> ReqBodyUrlEnc
-> Proxy (JsonResponse Value)
-> Option 'Https
-> Req (JsonResponse Value)
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 POST
POST Url 'Https
url (FormUrlEncodedParam -> ReqBodyUrlEnc
ReqBodyUrlEnc FormUrlEncodedParam
formBody) Proxy (JsonResponse Value)
forall a. Proxy (JsonResponse a)
jsonResponse Option 'Https
opts
evalOAuth2 :: TokenPair -> OAuth2 a -> IO a
evalOAuth2 :: TokenPair -> OAuth2 a -> IO a
evalOAuth2 = (OAuth2 a -> TokenPair -> IO a) -> TokenPair -> OAuth2 a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip OAuth2 a -> TokenPair -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
runOAuth2 :: TokenPair -> OAuth2 a -> IO (a, TokenPair)
runOAuth2 :: TokenPair -> OAuth2 a -> IO (a, TokenPair)
runOAuth2 = (OAuth2 a -> TokenPair -> IO (a, TokenPair))
-> TokenPair -> OAuth2 a -> IO (a, TokenPair)
forall a b c. (a -> b -> c) -> b -> a -> c
flip OAuth2 a -> TokenPair -> IO (a, TokenPair)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT