{-# 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
oAuth2AuthHeader :: ClientPair -> Option scheme
oAuth2AuthHeader 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
oAuth2BearerHeader :: AccessToken -> Option 'Https
oAuth2BearerHeader (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