haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-09-11 03:44:57 +02:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity

Wrap lines to 80 characters

Browse Source
This commit is contained in:
Brian Schroeder 2015-08-11 11:50:59 -04:00
parent f512806b55
commit a7edda4b3b
1 changed files with 23 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
Yesod/Auth/OAuth2/Nylas.hs
View File

@ -17,11 +17,13 @@ import Data.Monoid ((<>))
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Vector ((!?)) import Data.Vector ((!?))
import Network.HTTP.Client (applyBasicAuth, parseUrl, httpLbs, responseStatus, responseBody) import Network.HTTP.Client (applyBasicAuth, parseUrl, httpLbs, responseStatus
, responseBody)
import Network.HTTP.Conduit (Manager) import Network.HTTP.Conduit (Manager)
import Yesod.Auth (Creds(..), YesodAuth, AuthPlugin)
import Yesod.Auth import Yesod.Auth.OAuth2 (OAuth2(..), AccessToken(..)
import Yesod.Auth.OAuth2 , YesodOAuth2Exception(InvalidProfileResponse)
, authOAuth2)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types as HT
@ -51,32 +53,42 @@ oauth2Nylas :: YesodAuth m
=> Text -- ^ Client ID => Text -- ^ Client ID
-> Text -- ^ Client Secret -> Text -- ^ Client Secret
-> AuthPlugin m -> AuthPlugin m
oauth2Nylas clientId clientSecret = oauth2NylasScoped clientId clientSecret ["email"] oauth2Nylas clientId clientSecret =
oauth2NylasScoped clientId clientSecret ["email"]
oauth2NylasScoped :: YesodAuth m oauth2NylasScoped :: YesodAuth m
=> Text -- ^ Client ID => Text -- ^ Client ID
-> Text -- ^ Client Secret -> Text -- ^ Client Secret
-> [Text] -- ^ Scopes -> [Text] -- ^ Scopes
-> AuthPlugin m -> AuthPlugin m
oauth2NylasScoped clientId clientSecret scopes = authOAuth2 "nylas" oauth fetchCreds oauth2NylasScoped clientId clientSecret scopes =
authOAuth2 "nylas" oauth fetchCreds
where where
authorizeUrl = encodeUtf8
$ "https://api.nylas.com/oauth/authorize?scope="
<> T.intercalate "," scopes
tokenUrl = "https://api.nylas.com/oauth/token"
oauth = OAuth2 oauth = OAuth2
{ oauthClientId = encodeUtf8 clientId { oauthClientId = encodeUtf8 clientId
, oauthClientSecret = encodeUtf8 clientSecret , oauthClientSecret = encodeUtf8 clientSecret
, oauthOAuthorizeEndpoint = encodeUtf8 $ "https://api.nylas.com/oauth/authorize?scope=" <> T.intercalate "," scopes , oauthOAuthorizeEndpoint = authorizeUrl
, oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token" , oauthAccessTokenEndpoint = tokenUrl
, oauthCallback = Nothing , oauthCallback = Nothing
} }
fetchCreds :: Manager -> AccessToken -> IO (Creds a) fetchCreds :: Manager -> AccessToken -> IO (Creds a)
fetchCreds manager token = do fetchCreds manager token = do
req <- applyBasicAuth (accessToken token) "" <$> parseUrl "https://api.nylas.com/n" req <- authorize <$> parseUrl "https://api.nylas.com/n"
resp <- httpLbs req manager resp <- httpLbs req manager
if HT.statusIsSuccessful (responseStatus resp) if HT.statusIsSuccessful (responseStatus resp)
then case decode (responseBody resp) of then case decode (responseBody resp) of
Just ns -> return $ toCreds ns token Just ns -> return $ toCreds ns token
Nothing -> throwIO $ InvalidProfileResponse "nylas" "failed to parse namespace" Nothing -> throwIO parseFailure
else throwIO $ InvalidProfileResponse "nylas" "failed to get namespace" else throwIO requestFailure
where
authorize = applyBasicAuth (accessToken token) ""
parseFailure = InvalidProfileResponse "nylas" "failed to parse namespace"
requestFailure = InvalidProfileResponse "nylas" "failed to get namespace"
toCreds :: NylasNamespace -> AccessToken -> Creds a toCreds :: NylasNamespace -> AccessToken -> Creds a
toCreds ns token = Creds toCreds ns token = Creds