module Network.OAuth2.OAuth2
( OAuth2 (..)
, AccessToken (..)
, OAuthException (..)
, authorizationUrl
, accessTokenUrl
) where
import Data.Aeson
import qualified Data.ByteString.Char8 as BS
import Data.Typeable (Typeable)
import Network.HTTP.Types (renderSimpleQuery)
import Control.Exception
import Control.Applicative ((<$>))
import Control.Monad (mzero)
data OAuth2 = OAuth2 { oauthClientId :: BS.ByteString
, oauthClientSecret :: BS.ByteString
, oauthOAuthorizeEndpoint :: BS.ByteString
, oauthAccessTokenEndpoint :: BS.ByteString
, oauthCallback :: Maybe BS.ByteString
, oauthAccessToken :: Maybe BS.ByteString
} deriving (Show, Eq)
data OAuthException = OAuthException String
deriving (Show, Eq, Typeable)
instance Exception OAuthException
data AccessToken = AccessToken { accessToken :: BS.ByteString } deriving (Show)
instance FromJSON AccessToken where
parseJSON (Object o) = AccessToken <$> o .: "access_token"
parseJSON _ = mzero
type QueryParams = [(BS.ByteString, BS.ByteString)]
type PostBody = [(BS.ByteString, BS.ByteString)]
type URI = BS.ByteString
appendQueryParam :: URI -> QueryParams -> URI
appendQueryParam uri q = uri `BS.append` renderSimpleQuery True q
transform' :: [(a, Maybe b)] -> [(a, b)]
transform' = foldr step' []
where step' :: (a, Maybe b) -> [(a, b)] -> [(a, b)]
step' (a, Just b) xs = (a, b):xs
step' _ xs = xs
authorizationUrl :: OAuth2 -> URI
authorizationUrl oa = (oauthOAuthorizeEndpoint oa) `appendQueryParam` queryStr
where queryStr = transform' [ ("client_id", Just $ oauthClientId oa)
, ("response_type", Just "code")
, ("redirect_uri", oauthCallback oa)]
accessTokenUrl :: OAuth2
-> BS.ByteString
-> (URI, PostBody)
accessTokenUrl oa code = accessTokenUrl' oa code (Just "authorization_code")
accessTokenUrl' :: OAuth2
-> BS.ByteString
-> Maybe BS.ByteString
-> (URI, PostBody)
accessTokenUrl' oa code gt = (uri, body)
where uri = oauthAccessTokenEndpoint oa
body = transform' [ ("client_id", Just $ oauthClientId oa)
, ("client_secret", Just $ oauthClientSecret oa)
, ("code", Just code)
, ("redirect_uri", oauthCallback oa)
, ("grant_type", gt) ]