module Network.Google.OAuth2 (
OAuth2Client(..)
, OAuth2Scope
, OAuth2Tokens(..)
, googleScopes
, formUrl
, exchangeCode
, refreshTokens
, validateTokens
) where
import Data.ByteString.Char8 as BS8 (ByteString, pack)
import Data.ByteString.Lazy.UTF8 (toString)
import Data.List (intercalate)
import Network.Google (makeHeaderName)
import Network.HTTP.Base (urlEncode)
import Network.HTTP.Conduit (Request(..), RequestBody(..), Response(..), def, httpLbs, responseBody, withManager)
import Text.JSON (JSObject, JSValue(JSRational), Result(Ok), decode, valFromObj)
data OAuth2Client = OAuth2Client
{
clientId :: String
, clientSecret :: String
}
deriving (Read, Show)
type OAuth2Code = String
data OAuth2Tokens = OAuth2Tokens
{
accessToken :: String
, refreshToken :: String
, expiresIn :: Rational
, tokenType :: String
}
deriving (Read, Show)
type OAuth2Scope = String
googleScopes ::
[(String, OAuth2Scope)]
googleScopes =
[
("Adsense Management", "https://www.googleapis.com/auth/adsense")
, ("Google Affiliate Network", "https://www.googleapis.com/auth/gan")
, ("Analytics", "https://www.googleapis.com/auth/analytics.readonly")
, ("Google Books", "https://www.googleapis.com/auth/books")
, ("Blogger", "https://www.googleapis.com/auth/blogger")
, ("Calendar", "https://www.googleapis.com/auth/calendar")
, ("Google Cloud Storage", "https://www.googleapis.com/auth/devstorage.read_write")
, ("Contacts", "https://www.google.com/m8/feeds/")
, ("Content API for Shopping", "https://www.googleapis.com/auth/structuredcontent")
, ("Chrome Web Store", "https://www.googleapis.com/auth/chromewebstore.readonly")
, ("Documents List", "https://docs.google.com/feeds/")
, ("Google Drive", "https://www.googleapis.com/auth/drive")
, ("Google Drive Files", "Files https://www.googleapis.com/auth/drive.file")
, ("Gmail", "https://mail.google.com/mail/feed/atom")
, ("Google+", "https://www.googleapis.com/auth/plus.me")
, ("Groups Provisioning", "https://apps-apis.google.com/a/feeds/groups/")
, ("Google Latitude", "https://www.googleapis.com/auth/latitude.all.best https://www.googleapis.com/auth/latitude.all.city")
, ("Moderator", "https://www.googleapis.com/auth/moderator")
, ("Nicknames", "Provisioning https://apps-apis.google.com/a/feeds/alias/")
, ("Orkut", "https://www.googleapis.com/auth/orkut")
, ("Picasa Web", "https://picasaweb.google.com/data/")
, ("Sites", "https://sites.google.com/feeds/")
, ("Spreadsheets", "https://spreadsheets.google.com/feeds/")
, ("Tasks", "https://www.googleapis.com/auth/tasks")
, ("URL Shortener", "https://www.googleapis.com/auth/urlshortener")
, ("Userinfo - Email", "https://www.googleapis.com/auth/userinfo.email")
, ("Userinfo - Profile", "https://www.googleapis.com/auth/userinfo.profile")
, ("User Provisioning", "https://apps-apis.google.com/a/feeds/user/")
, ("Webmaster Tools", "https://www.google.com/webmasters/tools/feeds/")
, ("YouTube", "https://gdata.youtube.com")
]
redirectUri :: String
redirectUri = "urn:ietf:wg:oauth:2.0:oob"
formUrl ::
OAuth2Client
-> [OAuth2Scope]
-> String
formUrl client scopes =
"https://accounts.google.com/o/oauth2/auth"
++ "?response_type=code"
++ "&client_id=" ++ clientId client
++ "&redirect_uri=" ++ redirectUri
++ "&scope=" ++ intercalate "+" (map urlEncode scopes)
exchangeCode ::
OAuth2Client
-> OAuth2Code
-> IO OAuth2Tokens
exchangeCode client code =
do
result <- doOAuth2 client "authorization_code" ("&redirect_uri=" ++ redirectUri ++ "&code=" ++ code)
let
(Ok result') = decodeTokens Nothing result
return result'
decodeTokens ::
Maybe OAuth2Tokens
-> JSObject JSValue
-> Result OAuth2Tokens
decodeTokens tokens value =
do
let
(!) = flip valFromObj
expiresIn' :: Rational
(Ok (JSRational _ expiresIn')) = valFromObj "expires_in" value
accessToken <- value ! "access_token"
refreshToken <- maybe (value ! "refresh_token") (Ok . refreshToken) tokens
tokenType <- value ! "token_type"
return OAuth2Tokens
{
accessToken = accessToken
, refreshToken = refreshToken
, expiresIn = expiresIn'
, tokenType = tokenType
}
refreshTokens ::
OAuth2Client
-> OAuth2Tokens
-> IO OAuth2Tokens
refreshTokens client tokens =
do
result <- doOAuth2 client "refresh_token" ("&refresh_token=" ++ refreshToken tokens)
let
(Ok result') = decodeTokens (Just tokens) result
return result'
doOAuth2 ::
OAuth2Client
-> String
-> String
-> IO (JSObject JSValue)
doOAuth2 client grantType extraBody =
do
let
request =
def {
method = BS8.pack "POST"
, secure = True
, host = BS8.pack "accounts.google.com"
, port = 443
, path = BS8.pack "/o/oauth2/token"
, requestHeaders = [
(makeHeaderName "Content-Type", BS8.pack "application/x-www-form-urlencoded")
]
, requestBody = RequestBodyBS . BS8.pack
$ "client_id=" ++ clientId client
++ "&client_secret=" ++ clientSecret client
++ "&grant_type=" ++ grantType
++ extraBody
}
response <- withManager $ httpLbs request
let
(Ok result) = decode . toString $ responseBody response
return result
validateTokens ::
OAuth2Tokens
-> IO Rational
validateTokens tokens =
do
let
request =
def {
method = BS8.pack "GET"
, secure = True
, host = BS8.pack "www.googleapis.com"
, port = 443
, path = BS8.pack "/oauth2/v1/tokeninfo"
, queryString = BS8.pack ("?access_token=" ++ accessToken tokens)
}
response <- withManager $ httpLbs request
let
(Ok result) = decode . toString $ responseBody response
expiresIn' :: Rational
(Ok (JSRational _ expiresIn')) = valFromObj "expires_in" result
return expiresIn'