mirror of
https://github.com/freckle/yesod-auth-oauth2.git
synced 2026-02-21 07:07:53 +01:00
Remove extra fields from Salesforce
This commit is contained in:
patrick brisbin
parent
8cc250523b
commit
09e7c4c786
@ -50,6 +50,7 @@ module Yesod.Auth.OAuth2.Prelude
|
||||
, Creds(..)
|
||||
|
||||
-- * Bytestring URI types
|
||||
, URI
|
||||
, Host(..)
|
||||
|
||||
-- * Bytestring URI extensions
|
||||
|
||||
@ -1,12 +1,10 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://login.salesforce.com
|
||||
--
|
||||
-- * Authenticates against Salesforce
|
||||
-- * Authenticates against Salesforce (or sandbox)
|
||||
-- * Uses Salesforce user id as credentials identifier
|
||||
-- * Returns given_name, family_name, email and avatar_url as extras
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Salesforce
|
||||
( oauth2Salesforce
|
||||
@ -17,124 +15,60 @@ module Yesod.Auth.OAuth2.Salesforce
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
oauth2Salesforce :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2Salesforce = oauth2SalesforceScoped ["openid", "email", "api"]
|
||||
|
||||
svcName :: Text
|
||||
svcName = "salesforce"
|
||||
|
||||
oauth2SalesforceScoped :: YesodAuth m
|
||||
=> [Text] -- ^ List of scopes to request
|
||||
-> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2SalesforceScoped scopes clientId clientSecret =
|
||||
authOAuth2 svcName oauth fetchSalesforceUser
|
||||
where
|
||||
oauth = OAuth2
|
||||
{ oauthClientId = clientId
|
||||
, oauthClientSecret = clientSecret
|
||||
, oauthOAuthorizeEndpoint = "https://login.salesforce.com/services/oauth2/authorize" `withQuery`
|
||||
[ scopeParam " " scopes
|
||||
]
|
||||
, oauthAccessTokenEndpoint = "https://login.salesforce.com/services/oauth2/token"
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
|
||||
fetchSalesforceUser :: Manager -> OAuth2Token -> IO (Creds m)
|
||||
fetchSalesforceUser manager token = do
|
||||
result <- authGetJSON manager (accessToken token) "https://login.salesforce.com/services/oauth2/userinfo"
|
||||
case result of
|
||||
Right user -> return $ toCreds svcName user token
|
||||
Left err -> throwIO $ invalidProfileResponse svcName err
|
||||
|
||||
svcNameSb :: Text
|
||||
svcNameSb = "salesforce-sandbox"
|
||||
|
||||
oauth2SalesforceSandbox :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped ["openid", "email"]
|
||||
|
||||
|
||||
oauth2SalesforceSandboxScoped :: YesodAuth m
|
||||
=> [Text] -- ^ List of scopes to request
|
||||
-> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2SalesforceSandboxScoped scopes clientId clientSecret =
|
||||
authOAuth2 svcNameSb oauth fetchSalesforceSandboxUser
|
||||
where
|
||||
oauth = OAuth2
|
||||
{ oauthClientId = clientId
|
||||
, oauthClientSecret = clientSecret
|
||||
, oauthOAuthorizeEndpoint = "https://test.salesforce.com/services/oauth2/authorize" `withQuery`
|
||||
[ scopeParam " " scopes
|
||||
]
|
||||
, oauthAccessTokenEndpoint = "https://test.salesforce.com/services/oauth2/token"
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
|
||||
fetchSalesforceSandboxUser :: Manager -> OAuth2Token -> IO (Creds m)
|
||||
fetchSalesforceSandboxUser manager token = do
|
||||
result <- authGetJSON manager (accessToken token) "https://test.salesforce.com/services/oauth2/userinfo"
|
||||
case result of
|
||||
Right user -> return $ toCreds svcNameSb user token
|
||||
Left err -> throwIO $ invalidProfileResponse svcNameSb err
|
||||
|
||||
data User = User
|
||||
{ userId :: Text
|
||||
, userOrg :: Text
|
||||
, userNickname :: Text
|
||||
, userName :: Text
|
||||
, userGivenName :: Text
|
||||
, userFamilyName :: Text
|
||||
, userTimeZone :: Text
|
||||
, userEmail :: Text
|
||||
, userPicture :: Text
|
||||
, userPhone :: Maybe Text
|
||||
, userRestUrl :: Text
|
||||
}
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> do
|
||||
userId <- o .: "user_id"
|
||||
userOrg <- o .: "organization_id"
|
||||
userNickname <- o .: "nickname"
|
||||
userName <- o .: "name"
|
||||
userGivenName <- o .: "given_name"
|
||||
userFamilyName <- o .: "family_name"
|
||||
userTimeZone <- o .: "zoneinfo"
|
||||
userEmail <- o .: "email"
|
||||
userPicture <- o .: "picture"
|
||||
userPhone <- o .:? "phone_number"
|
||||
urls <- o .: "urls"
|
||||
userRestUrl <- urls .: "rest"
|
||||
return User{..}
|
||||
parseJSON = withObject "User" $ \o -> User
|
||||
<$> o .: "user_id"
|
||||
|
||||
toCreds :: Text -> User -> OAuth2Token -> Creds m
|
||||
toCreds name user token = Creds
|
||||
{ credsPlugin = name
|
||||
, credsIdent = userId user
|
||||
, credsExtra =
|
||||
[ ("email", userEmail user)
|
||||
, ("org", userOrg user)
|
||||
, ("nickname", userName user)
|
||||
, ("name", userName user)
|
||||
, ("given_name", userGivenName user)
|
||||
, ("family_name", userFamilyName user)
|
||||
, ("time_zone", userTimeZone user)
|
||||
, ("avatar_url", userPicture user)
|
||||
, ("rest_url", userRestUrl user)
|
||||
, ("access_token", atoken $ accessToken token)
|
||||
]
|
||||
++ maybeExtra "refresh_token" (rtoken <$> refreshToken token)
|
||||
++ maybeExtra "expires_in" (T.pack . show <$> expiresIn token)
|
||||
++ maybeExtra "phone_number" (userPhone user)
|
||||
}
|
||||
pluginName :: Text
|
||||
pluginName = "salesforce"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["openid", "email", "api"]
|
||||
|
||||
oauth2Salesforce :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2Salesforce = oauth2SalesforceScoped defaultScopes
|
||||
|
||||
oauth2SalesforceScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2SalesforceScoped = salesforceHelper pluginName
|
||||
"https://login.salesforce.com/services/oauth2/userinfo"
|
||||
"https://login.salesforce.com/services/oauth2/authorize"
|
||||
"https://login.salesforce.com/services/oauth2/token"
|
||||
|
||||
oauth2SalesforceSandbox :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped defaultScopes
|
||||
|
||||
oauth2SalesforceSandboxScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2SalesforceSandboxScoped = salesforceHelper (pluginName <> "-sandbox")
|
||||
"https://test.salesforce.com/services/oauth2/userinfo"
|
||||
"https://test.salesforce.com/services/oauth2/authorize"
|
||||
"https://test.salesforce.com/services/oauth2/token"
|
||||
|
||||
salesforceHelper
|
||||
:: YesodAuth m
|
||||
=> Text
|
||||
-> URI -- ^ User profile
|
||||
-> URI -- ^ Authorize
|
||||
-> URI -- ^ Token
|
||||
-> [Text]
|
||||
-> Text
|
||||
-> Text
|
||||
-> AuthPlugin m
|
||||
salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSecret =
|
||||
authOAuth2 name oauth2 $ \manager token -> do
|
||||
(User userId, userResponseJSON) <- authGetProfile name manager token profileUri
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponseJSON
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauthClientId = clientId
|
||||
, oauthClientSecret = clientSecret
|
||||
, oauthOAuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes]
|
||||
, oauthAccessTokenEndpoint = tokenUri
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user