module Network.OAuth.OAuth2.HttpClient (
authGetJSON,
authGetBS,
authGetBS2,
authGetJSONWithAuthMethod,
authGetJSONInternal,
authGetBSWithAuthMethod,
authGetBSInternal,
authPostJSON,
authPostBS,
authPostBS2,
authPostBS3,
authPostJSONWithAuthMethod,
authPostJSONInternal,
authPostBSWithAuthMethod,
authPostBSInternal,
APIAuthenticationMethod (..),
) where
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except (ExceptT (..), throwE)
import Data.Aeson (FromJSON, eitherDecode)
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy.Char8 qualified as BSL
import Data.Maybe (fromJust, isJust)
import Data.Text.Encoding qualified as T
import Lens.Micro (over)
import Network.HTTP.Client.Contrib (handleResponse)
import Network.HTTP.Conduit
import Network.HTTP.Types qualified as HT
import Network.OAuth.OAuth2.Internal
import URI.ByteString (URI, URIRef, queryL, queryPairsL)
authGetJSON ::
(MonadIO m, FromJSON a) =>
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m a
authGetJSON :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSON = forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
authGetJSONInternal ::
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m a
authGetJSONInternal :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONInternal = forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONWithAuthMethod
{-# DEPRECATED authGetJSONInternal "use authGetJSONWithAuthMethod" #-}
authGetJSONWithAuthMethod ::
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m a
authGetJSONWithAuthMethod :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
t URI
uri = do
ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
t URI
uri
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BSL.pack) forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
resp)
authGetBS ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m BSL.ByteString
authGetBS :: forall (m :: * -> *).
MonadIO m =>
Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBS = forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
authGetBS2 ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m BSL.ByteString
authGetBS2 :: forall (m :: * -> *).
MonadIO m =>
Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBS2 = forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod APIAuthenticationMethod
AuthInRequestQuery
{-# DEPRECATED authGetBS2 "use authGetBSWithAuthMethod" #-}
authGetBSInternal ::
MonadIO m =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m BSL.ByteString
authGetBSInternal :: forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSInternal = forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod
{-# DEPRECATED authGetBSInternal "use authGetBSWithAuthMethod" #-}
authGetBSWithAuthMethod ::
MonadIO m =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m BSL.ByteString
authGetBSWithAuthMethod :: forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url = do
let appendToUrl :: Bool
appendToUrl = APIAuthenticationMethod
AuthInRequestQuery forall a. Eq a => a -> a -> Bool
== APIAuthenticationMethod
authTypes
let appendToHeader :: Bool
appendToHeader = APIAuthenticationMethod
AuthInRequestHeader forall a. Eq a => a -> a -> Bool
== APIAuthenticationMethod
authTypes
let uri :: URI
uri = if Bool
appendToUrl then URI
url forall a. URIRef a -> AccessToken -> URIRef a
`appendAccessToken` AccessToken
token else URI
url
let upReq :: Request -> Request
upReq = Maybe AccessToken -> Request -> Request
updateRequestHeaders (if Bool
appendToHeader then forall a. a -> Maybe a
Just AccessToken
token else forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
setMethod StdMethod
HT.GET
Request
req <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
uri
forall (m :: * -> *).
MonadIO m =>
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString m ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
authPostJSON ::
(MonadIO m, FromJSON a) =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m a
authPostJSON :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager -> AccessToken -> URI -> PostBody -> ExceptT ByteString m a
authPostJSON = forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
authPostJSONWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
authPostJSONInternal ::
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m a
authPostJSONInternal :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
authPostJSONInternal = forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
authPostJSONWithAuthMethod
{-# DEPRECATED authPostJSONInternal "use 'authPostJSONWithAuthMethod'" #-}
authPostJSONWithAuthMethod ::
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m a
authPostJSONWithAuthMethod :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
authPostJSONWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body = do
ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BSL.pack) forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
resp)
authPostBS ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBS :: forall (m :: * -> *).
MonadIO m =>
Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBS = forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
authPostBS2 ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBS2 :: forall (m :: * -> *).
MonadIO m =>
Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBS2 = forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
AuthInRequestBody
{-# DEPRECATED authPostBS2 "use 'authPostBSWithAuthMethod'" #-}
authPostBS3 ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBS3 :: forall (m :: * -> *).
MonadIO m =>
Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBS3 = forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
{-# DEPRECATED authPostBS3 "use 'authPostBSWithAuthMethod'" #-}
authPostBSInternal ::
MonadIO m =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBSInternal :: forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSInternal = forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod
{-# DEPRECATED authPostBSInternal "use 'authPostBSWithAuthMethod'" #-}
authPostBSWithAuthMethod ::
MonadIO m =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBSWithAuthMethod :: forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body = do
let appendToBody :: Bool
appendToBody = APIAuthenticationMethod
AuthInRequestBody forall a. Eq a => a -> a -> Bool
== APIAuthenticationMethod
authTypes
let appendToHeader :: Bool
appendToHeader = APIAuthenticationMethod
AuthInRequestHeader forall a. Eq a => a -> a -> Bool
== APIAuthenticationMethod
authTypes
let reqBody :: PostBody
reqBody = if Bool
appendToBody then PostBody
body forall a. [a] -> [a] -> [a]
++ AccessToken -> PostBody
accessTokenToParam AccessToken
token else PostBody
body
let upBody :: Request -> Request
upBody = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null PostBody
reqBody then forall a. a -> a
id else PostBody -> Request -> Request
urlEncodedBody PostBody
reqBody
let upHeaders :: Request -> Request
upHeaders = Maybe AccessToken -> Request -> Request
updateRequestHeaders (if Bool
appendToHeader then forall a. a -> Maybe a
Just AccessToken
token else forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
setMethod StdMethod
HT.POST
let upReq :: Request -> Request
upReq = Request -> Request
upHeaders forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
upBody
Request
req <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
forall (m :: * -> *).
MonadIO m =>
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString m ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
data APIAuthenticationMethod
=
|
AuthInRequestBody
|
AuthInRequestQuery
deriving (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c/= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
== :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c== :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
Eq, Eq APIAuthenticationMethod
APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
$cmin :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
max :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
$cmax :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
>= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c>= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
> :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c> :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
<= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c<= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
< :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c< :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
compare :: APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
$ccompare :: APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
Ord)
authRequest ::
MonadIO m =>
Request ->
(Request -> Request) ->
Manager ->
ExceptT BSL.ByteString m BSL.ByteString
authRequest :: forall (m :: * -> *).
MonadIO m =>
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString m ByteString
authRequest Request
req Request -> Request
upReq Manager
manage = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
Response ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs (Request -> Request
upReq Request
req) Manager
manage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response ByteString -> Either ByteString ByteString
handleResponse Response ByteString
resp)
updateRequestHeaders :: Maybe AccessToken -> Request -> Request
Maybe AccessToken
t Request
req =
let bearer :: [(HeaderName, ByteString)]
bearer = [(HeaderName
HT.hAuthorization, ByteString
"Bearer " ByteString -> ByteString -> ByteString
`BS.append` Text -> ByteString
T.encodeUtf8 (AccessToken -> Text
atoken (forall a. HasCallStack => Maybe a -> a
fromJust Maybe AccessToken
t))) | forall a. Maybe a -> Bool
isJust Maybe AccessToken
t]
headers :: [(HeaderName, ByteString)]
headers = [(HeaderName, ByteString)]
bearer forall a. [a] -> [a] -> [a]
++ [(HeaderName, ByteString)]
defaultRequestHeaders forall a. [a] -> [a] -> [a]
++ Request -> [(HeaderName, ByteString)]
requestHeaders Request
req
in Request
req {requestHeaders :: [(HeaderName, ByteString)]
requestHeaders = [(HeaderName, ByteString)]
headers}
setMethod :: HT.StdMethod -> Request -> Request
setMethod :: StdMethod -> Request -> Request
setMethod StdMethod
m Request
req = Request
req {method :: ByteString
method = StdMethod -> ByteString
HT.renderStdMethod StdMethod
m}
appendAccessToken ::
URIRef a ->
AccessToken ->
URIRef a
appendAccessToken :: forall a. URIRef a -> AccessToken -> URIRef a
appendAccessToken URIRef a
uri AccessToken
t = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall a. Lens' (URIRef a) Query
queryL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Query PostBody
queryPairsL) (\PostBody
query -> PostBody
query forall a. [a] -> [a] -> [a]
++ AccessToken -> PostBody
accessTokenToParam AccessToken
t) URIRef a
uri
accessTokenToParam :: AccessToken -> [(BS.ByteString, BS.ByteString)]
accessTokenToParam :: AccessToken -> PostBody
accessTokenToParam AccessToken
t = [(ByteString
"access_token", Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ AccessToken -> Text
atoken AccessToken
t)]