{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.OAuth.OAuth2.HttpClient
(
authGetJSON,
authGetBS,
authGetBS2,
authGetJSONInternal,
authGetBSInternal,
authPostJSON,
authPostBS,
authPostBS1,
authPostBS2,
authPostBS3,
authPostJSONInternal,
authPostBSInternal,
)
where
import qualified Data.Set as Set
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except
import Data.Aeson
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Maybe
import qualified Data.Text.Encoding as T
import Lens.Micro
import Network.HTTP.Conduit
import qualified Network.HTTP.Types as HT
import Network.OAuth.OAuth2.Internal
import URI.ByteString
authGetJSON ::
(FromJSON b) =>
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString IO b
authGetJSON :: Manager -> AccessToken -> URI -> ExceptT ByteString IO b
authGetJSON = Set APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString IO b
forall b.
FromJSON b =>
Set APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString IO b
authGetJSONInternal ([APIAuthenticationMethod] -> Set APIAuthenticationMethod
forall a. Ord a => [a] -> Set a
Set.fromList [APIAuthenticationMethod
AuthInRequestHeader])
{-# DEPRECATED authGetJSON "use authGetJSONInternal" #-}
authGetJSONInternal ::
(FromJSON b) =>
Set.Set APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString IO b
authGetJSONInternal :: Set APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString IO b
authGetJSONInternal Set APIAuthenticationMethod
authTypes Manager
manager AccessToken
t URI
uri = do
ByteString
resp <- Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> ExceptT ByteString IO ByteString
authGetBSInternal Set APIAuthenticationMethod
authTypes Manager
manager AccessToken
t URI
uri
([Char] -> ExceptT ByteString IO b)
-> (b -> ExceptT ByteString IO b)
-> Either [Char] b
-> ExceptT ByteString IO b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> ExceptT ByteString IO b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ByteString -> ExceptT ByteString IO b)
-> ([Char] -> ByteString) -> [Char] -> ExceptT ByteString IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BSL.pack) b -> ExceptT ByteString IO b
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either [Char] b
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
resp)
authGetBS ::
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString IO BSL.ByteString
authGetBS :: Manager -> AccessToken -> URI -> ExceptT ByteString IO ByteString
authGetBS = Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> ExceptT ByteString IO ByteString
authGetBSInternal (Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> ExceptT ByteString IO ByteString)
-> Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> ExceptT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ [APIAuthenticationMethod] -> Set APIAuthenticationMethod
forall a. Ord a => [a] -> Set a
Set.fromList [APIAuthenticationMethod
AuthInRequestHeader]
authGetBS2 ::
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString IO BSL.ByteString
authGetBS2 :: Manager -> AccessToken -> URI -> ExceptT ByteString IO ByteString
authGetBS2 = Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> ExceptT ByteString IO ByteString
authGetBSInternal (Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> ExceptT ByteString IO ByteString)
-> Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> ExceptT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ [APIAuthenticationMethod] -> Set APIAuthenticationMethod
forall a. Ord a => [a] -> Set a
Set.fromList [APIAuthenticationMethod
AuthInRequestQuery]
{-# DEPRECATED authGetBS2 "use authGetBSInternal" #-}
authGetBSInternal ::
Set.Set APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString IO BSL.ByteString
authGetBSInternal :: Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> ExceptT ByteString IO ByteString
authGetBSInternal Set APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url = do
let appendToUrl :: Bool
appendToUrl = APIAuthenticationMethod
AuthInRequestQuery APIAuthenticationMethod -> Set APIAuthenticationMethod -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set APIAuthenticationMethod
authTypes
let appendToHeader :: Bool
appendToHeader = APIAuthenticationMethod
AuthInRequestHeader APIAuthenticationMethod -> Set APIAuthenticationMethod -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set APIAuthenticationMethod
authTypes
let uri :: URI
uri = if Bool
appendToUrl then URI
url URI -> AccessToken -> URI
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 AccessToken -> Maybe AccessToken
forall a. a -> Maybe a
Just AccessToken
token else Maybe AccessToken
forall a. Maybe a
Nothing) (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
setMethod StdMethod
HT.GET
Request
req <- IO Request -> ExceptT ByteString IO Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> ExceptT ByteString IO Request)
-> IO Request -> ExceptT ByteString IO Request
forall a b. (a -> b) -> a -> b
$ URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
uri
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
authPostJSON ::
(FromJSON b) =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString IO b
authPostJSON :: Manager
-> AccessToken -> URI -> PostBody -> ExceptT ByteString IO b
authPostJSON = Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO b
forall a.
FromJSON a =>
Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO a
authPostJSONInternal (Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO b)
-> Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO b
forall a b. (a -> b) -> a -> b
$ [APIAuthenticationMethod] -> Set APIAuthenticationMethod
forall a. Ord a => [a] -> Set a
Set.fromList [APIAuthenticationMethod
AuthInRequestHeader]
{-# DEPRECATED authPostJSON "use authPostJSONInternal" #-}
authPostJSONInternal ::
FromJSON a =>
Set.Set APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString IO a
authPostJSONInternal :: Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO a
authPostJSONInternal Set APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body = do
ByteString
resp <- Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBSInternal Set APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body
([Char] -> ExceptT ByteString IO a)
-> (a -> ExceptT ByteString IO a)
-> Either [Char] a
-> ExceptT ByteString IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> ExceptT ByteString IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ByteString -> ExceptT ByteString IO a)
-> ([Char] -> ByteString) -> [Char] -> ExceptT ByteString IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BSL.pack) a -> ExceptT ByteString IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
resp)
authPostBS ::
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString IO BSL.ByteString
authPostBS :: Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBS = Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBSInternal (Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString)
-> Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ [APIAuthenticationMethod] -> Set APIAuthenticationMethod
forall a. Ord a => [a] -> Set a
Set.fromList [APIAuthenticationMethod
AuthInRequestHeader]
authPostBS1 ::
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString IO BSL.ByteString
authPostBS1 :: Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBS1 = Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBSInternal (Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString)
-> Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ [APIAuthenticationMethod] -> Set APIAuthenticationMethod
forall a. Ord a => [a] -> Set a
Set.fromList [APIAuthenticationMethod
AuthInRequestBody, APIAuthenticationMethod
AuthInRequestHeader]
{-# DEPRECATED authPostBS1 "use authPostBSInternal" #-}
authPostBS2 ::
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString IO BSL.ByteString
authPostBS2 :: Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBS2 = Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBSInternal (Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString)
-> Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ [APIAuthenticationMethod] -> Set APIAuthenticationMethod
forall a. Ord a => [a] -> Set a
Set.fromList [APIAuthenticationMethod
AuthInRequestBody]
{-# DEPRECATED authPostBS2 "use authPostBSInternal" #-}
authPostBS3 ::
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString IO BSL.ByteString
authPostBS3 :: Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBS3 = Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBSInternal (Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString)
-> Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ [APIAuthenticationMethod] -> Set APIAuthenticationMethod
forall a. Ord a => [a] -> Set a
Set.fromList [APIAuthenticationMethod
AuthInRequestHeader]
{-# DEPRECATED authPostBS3 "use authPostBSInternal" #-}
authPostBSInternal ::
Set.Set APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString IO BSL.ByteString
authPostBSInternal :: Set APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBSInternal Set APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body = do
let appendToBody :: Bool
appendToBody = APIAuthenticationMethod
AuthInRequestBody APIAuthenticationMethod -> Set APIAuthenticationMethod -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set APIAuthenticationMethod
authTypes
let appendToHeader :: Bool
appendToHeader = APIAuthenticationMethod
AuthInRequestHeader APIAuthenticationMethod -> Set APIAuthenticationMethod -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set APIAuthenticationMethod
authTypes
let reqBody :: PostBody
reqBody = if Bool
appendToBody then PostBody
body PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ AccessToken -> PostBody
accessTokenToParam AccessToken
token else PostBody
body
let upBody :: Request -> Request
upBody = if PostBody -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null PostBody
reqBody then Request -> Request
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 AccessToken -> Maybe AccessToken
forall a. a -> Maybe a
Just AccessToken
token else Maybe AccessToken
forall a. Maybe a
Nothing) (Request -> Request) -> (Request -> Request) -> Request -> Request
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 (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
upBody
Request
req <- URI -> ExceptT ByteString IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
authRequest ::
Request ->
(Request -> Request) ->
Manager ->
ExceptT BSL.ByteString IO BSL.ByteString
authRequest :: Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manage = IO (Either ByteString ByteString)
-> ExceptT ByteString IO ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ByteString ByteString)
-> ExceptT ByteString IO ByteString)
-> IO (Either ByteString ByteString)
-> ExceptT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Either ByteString ByteString
handleResponse (Response ByteString -> Either ByteString ByteString)
-> IO (Response ByteString) -> IO (Either ByteString ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs (Request -> Request
upReq Request
req) Manager
manage
handleResponse :: Response BSL.ByteString -> Either BSL.ByteString BSL.ByteString
handleResponse :: Response ByteString -> Either ByteString ByteString
handleResponse Response ByteString
rsp =
if Status -> Bool
HT.statusIsSuccessful (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
rsp)
then ByteString -> Either ByteString ByteString
forall a b. b -> Either a b
Right (ByteString -> Either ByteString ByteString)
-> ByteString -> Either ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp
else
ByteString -> Either ByteString ByteString
forall a b. a -> Either a b
Left (ByteString -> Either ByteString ByteString)
-> ByteString -> Either ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp
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 (Maybe AccessToken -> AccessToken
forall a. HasCallStack => Maybe a -> a
fromJust Maybe AccessToken
t))) | Maybe AccessToken -> Bool
forall a. Maybe a -> Bool
isJust Maybe AccessToken
t]
headers :: [(HeaderName, ByteString)]
headers = [(HeaderName, ByteString)]
bearer [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. [a] -> [a] -> [a]
++ [(HeaderName, ByteString)]
defaultRequestHeaders [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
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 :: URIRef a -> AccessToken -> URIRef a
appendAccessToken URIRef a
uri AccessToken
t = ASetter (URIRef a) (URIRef a) PostBody PostBody
-> (PostBody -> PostBody) -> URIRef a -> URIRef a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Query -> Identity Query) -> URIRef a -> Identity (URIRef a)
forall a. Lens' (URIRef a) Query
queryL ((Query -> Identity Query) -> URIRef a -> Identity (URIRef a))
-> ((PostBody -> Identity PostBody) -> Query -> Identity Query)
-> ASetter (URIRef a) (URIRef a) PostBody PostBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PostBody -> Identity PostBody) -> Query -> Identity Query
Lens' Query PostBody
queryPairsL) (\PostBody
query -> PostBody
query PostBody -> PostBody -> PostBody
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 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AccessToken -> Text
atoken AccessToken
t)]