yesod-auth-oauth2 0.2.4 → 0.3.0
raw patch · 13 files changed
+220/−155 lines, 13 filesdep +microlensdep +uri-bytestringdep ~aesondep ~hoauth2dep ~vector
Dependencies added: microlens, uri-bytestring
Dependency ranges changed: aeson, hoauth2, vector
Files
- URI/ByteString/Extension.hs +53/−0
- Yesod/Auth/OAuth2.hs +37/−28
- Yesod/Auth/OAuth2/BattleNet.hs +20/−17
- Yesod/Auth/OAuth2/Bitbucket.hs +13/−13
- Yesod/Auth/OAuth2/EveOnline.hs +11/−10
- Yesod/Auth/OAuth2/Github.hs +12/−12
- Yesod/Auth/OAuth2/Google.hs +13/−15
- Yesod/Auth/OAuth2/Nylas.hs +14/−15
- Yesod/Auth/OAuth2/Salesforce.hs +19/−17
- Yesod/Auth/OAuth2/Slack.hs +11/−15
- Yesod/Auth/OAuth2/Spotify.hs +6/−6
- Yesod/Auth/OAuth2/Upcase.hs +2/−3
- yesod-auth-oauth2.cabal +9/−4
+ URI/ByteString/Extension.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module URI.ByteString.Extension where++import Data.ByteString (ByteString)+import Data.String (IsString(..))+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Lens.Micro++import qualified Data.ByteString.Char8 as C8++import URI.ByteString++instance IsString Scheme where+ fromString = Scheme . fromString++instance IsString Host where+ fromString = Host . fromString++instance IsString (URIRef Absolute) where+ fromString = either (error . show) id+ . parseURI strictURIParserOptions+ . C8.pack++instance IsString (URIRef Relative) where+ fromString = either (error . show) id+ . parseRelativeRef strictURIParserOptions+ . C8.pack++fromText :: Text -> Maybe URI+fromText = either (const Nothing) Just+ . parseURI strictURIParserOptions+ . encodeUtf8++unsafeFromText :: Text -> URI+unsafeFromText = either (error . show) id+ . parseURI strictURIParserOptions+ . encodeUtf8++toText :: URI -> Text+toText = decodeUtf8 . serializeURIRef'++fromRelative :: Scheme -> Host -> RelativeRef -> URI+fromRelative s h = flip withHost h . toAbsolute s++withHost :: URIRef a -> Host -> URIRef a+withHost u h = u & authorityL %~ maybe+ (Just $ Authority Nothing h Nothing)+ (\a -> Just $ a & authorityHostL .~ h)++withQuery :: URIRef a -> [(ByteString, ByteString)] -> URIRef a+withQuery u q = u & (queryL . queryPairsL) %~ (++ q)
Yesod/Auth/OAuth2.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TupleSections #-} -- | -- -- Generic OAuth2 plugin for Yesod@@ -15,8 +16,12 @@ , oauth2Url , fromProfileURL , YesodOAuth2Exception(..)+ , invalidProfileResponse+ , scopeParam , maybeExtra , module Network.OAuth.OAuth2+ , module URI.ByteString+ , module URI.ByteString.Extension ) where #if __GLASGOW_HASKELL__ < 710@@ -26,20 +31,22 @@ import Control.Exception.Lifted import Control.Monad.IO.Class import Control.Monad (unless)-import Data.ByteString (ByteString)+import Data.Aeson (Value(..), encode) import Data.Monoid ((<>))+import Data.ByteString (ByteString) import Data.Text (Text, pack)-import Data.Text.Encoding (decodeUtf8With, encodeUtf8)-import Data.Text.Encoding.Error (lenientDecode)+import Data.Text.Encoding (encodeUtf8) import Data.Typeable import Network.HTTP.Conduit (Manager)-import Network.OAuth.OAuth2+import Network.OAuth.OAuth2 hiding (error) import System.Random+import URI.ByteString+import URI.ByteString.Extension import Yesod.Auth import Yesod.Core +import qualified Data.Text as T import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Char8 as C8 -- | Provider name and Aeson parse error data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString@@ -47,6 +54,14 @@ instance Exception YesodOAuth2Exception +-- | Construct an @'InvalidProfileResponse'@ exception from an @'OAuth2Error'@+--+-- This forces the @e@ in @'OAuth2Error' e@ to parse as a JSON @'Value'@ which+-- is then re-encoded for the exception message.+--+invalidProfileResponse :: Text -> OAuth2Error Value -> YesodOAuth2Exception+invalidProfileResponse name = InvalidProfileResponse name . encode+ oauth2Url :: Text -> AuthRoute oauth2Url name = PluginR name ["forward"] @@ -57,11 +72,11 @@ authOAuth2 :: YesodAuth m => Text -- ^ Service name -> OAuth2 -- ^ Service details- -> (Manager -> AccessToken -> IO (Creds m))- -- ^ This function defines how to take an @'AccessToken'@ and- -- retrieve additional information about the user, to be- -- set in the session as @'Creds'@. Usually this means a- -- second authorized request to @api/me.json@.+ -> (Manager -> OAuth2Token -> IO (Creds m))+ -- ^ This function defines how to take an @'OAuth2Token'@ and+ -- retrieve additional information about the user, to be set in the+ -- session as @'Creds'@. Usually this means a second authorized+ -- request to @api/me.json@. -- -- See @'fromProfileURL'@ for an example. -> AuthPlugin m@@ -76,7 +91,7 @@ => WidgetT m IO () -> Text -> OAuth2- -> (Manager -> AccessToken -> IO (Creds m))+ -> (Manager -> OAuth2Token -> IO (Creds m)) -> AuthPlugin m authOAuth2Widget widget name oauth getCreds = AuthPlugin name dispatch login @@ -87,15 +102,15 @@ tm <- getRouteToParent render <- lift getUrlRender return oauth- { oauthCallback = Just $ encodeUtf8 $ render $ tm url+ { oauthCallback = Just $ unsafeFromText $ render $ tm url , oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth- `appendQuery` "state=" <> encodeUtf8 csrfToken+ `withQuery` [("state", encodeUtf8 csrfToken)] } dispatch "GET" ["forward"] = do csrfToken <- liftIO generateToken setSession tokenSessionKey csrfToken- authUrl <- bsToText . authorizationUrl <$> withCallback csrfToken+ authUrl <- toText . authorizationUrl <$> withCallback csrfToken lift $ redirect authUrl dispatch "GET" ["callback"] = do@@ -106,9 +121,9 @@ code <- requireGetParam "code" oauth' <- withCallback csrfToken master <- lift getYesod- result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (encodeUtf8 code)+ result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (ExchangeToken code) case result of- Left _ -> permissionDenied "Unable to retreive OAuth2 token"+ Left _ -> permissionDenied "Unable to retrieve OAuth2 token" Right token -> do creds <- liftIO $ getCreds (authHttpManager master) token lift $ setCredsRedirect creds@@ -134,25 +149,19 @@ => Text -- ^ Plugin name -> URI -- ^ Profile URI -> (a -> Creds m) -- ^ Conversion to Creds- -> Manager -> AccessToken -> IO (Creds m)+ -> Manager -> OAuth2Token -> IO (Creds m) fromProfileURL name url toCreds manager token = do- result <- authGetJSON manager token url+ result <- authGetJSON manager (accessToken token) url case result of Right profile -> return $ toCreds profile- Left err -> throwIO $ InvalidProfileResponse name err--bsToText :: ByteString -> Text-bsToText = decodeUtf8With lenientDecode+ Left err -> throwIO $ invalidProfileResponse name err -appendQuery :: ByteString -> ByteString -> ByteString-appendQuery url query =- if '?' `C8.elem` url- then url <> "&" <> query- else url <> "?" <> query+-- | A tuple of @scope@ and the given scopes separated by a delimiter+scopeParam :: Text -> [Text] -> (ByteString, ByteString)+scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d -- | A helper for providing an optional value to credsExtra--- maybeExtra :: Text -> Maybe Text -> [(Text, Text)] maybeExtra k (Just v) = [(k, v)] maybeExtra _ Nothing = []
Yesod/Auth/OAuth2/BattleNet.hs view
@@ -51,30 +51,33 @@ -> Text -- ^ User region (e.g. "eu", "cn", "us") -> WidgetT m IO () -- ^ Login widget -> AuthPlugin m -oAuth2BattleNet clientId clientSecret region widget = authOAuth2Widget widget "battle.net" oAuthData (makeCredentials region) - where oAuthData = OAuth2 { oauthClientId = E.encodeUtf8 clientId - , oauthClientSecret = E.encodeUtf8 clientSecret - , oauthOAuthorizeEndpoint = E.encodeUtf8 ("https://" <> host <> "/oauth/authorize") - , oauthAccessTokenEndpoint = E.encodeUtf8 ("https://" <> host <> "/oauth/token") +oAuth2BattleNet clientId clientSecret region widget = authOAuth2Widget widget "battle.net" oAuthData $ makeCredentials region + where oAuthData = OAuth2 { oauthClientId = clientId + , oauthClientSecret = clientSecret + , oauthOAuthorizeEndpoint = fromRelative "https" host "/oauth/authorize" + , oauthAccessTokenEndpoint = fromRelative "https" host "/oauth/token" , oauthCallback = Nothing } - host = let r = T.toLower region in - case r of - "cn" -> "www.battlenet.com.cn" - _ -> r <> ".battle.net" -makeCredentials :: Text -> Manager -> AccessToken -> IO (Creds m) + host = wwwHost $ T.toLower region + +makeCredentials :: Text -> Manager -> OAuth2Token -> IO (Creds m) makeCredentials region manager token = do - userResult <- authGetJSON manager token ("https://" <> host <> "/account/user") :: IO (OAuth2Result BattleNetUser) + userResult <- authGetJSON manager (accessToken token) + $ fromRelative "https" (apiHost $ T.toLower region) "/account/user" + case userResult of - Left err -> throwIO $ InvalidProfileResponse "battle.net" err + Left err -> throwIO $ invalidProfileResponse "battle.net" err Right user -> return Creds { credsPlugin = "battle.net" , credsIdent = T.pack $ show $ userId user , credsExtra = [("battletag", battleTag user)] } - where host :: URI - host = let r = T.toLower region in - case r of - "cn" -> "api.battlenet.com.cn" - _ -> E.encodeUtf8 r <> ".api.battle.net" + +apiHost :: Text -> Host +apiHost "cn" = "api.battlenet.com.cn" +apiHost region = Host $ E.encodeUtf8 $ region <> ".api.battle.net" + +wwwHost :: Text -> Host +wwwHost "cn" = "www.battlenet.com.cn" +wwwHost region = Host $ E.encodeUtf8 $ region <> ".battle.net"
Yesod/Auth/OAuth2/Bitbucket.hs view
@@ -23,12 +23,10 @@ import Data.Aeson (FromJSON, Value(Object), parseJSON, (.:), (.:?)) import Data.Maybe (fromMaybe) import Data.List (find)-import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Network.HTTP.Conduit (Manager) import Yesod.Auth (YesodAuth, Creds(..), AuthPlugin)-import Yesod.Auth.OAuth2 (AccessToken, YesodOAuth2Exception(InvalidProfileResponse), OAuth2(..), authOAuth2, maybeExtra, accessToken, authGetJSON)+import Yesod.Auth.OAuth2 import qualified Data.Text as T @@ -106,24 +104,26 @@ oauth2BitbucketScoped clientId clientSecret scopes = authOAuth2 "bitbucket" oauth fetchBitbucketProfile where oauth = OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://bitbucket.com/site/oauth2/authorize?scope=" <> T.intercalate "," scopes+ { oauthClientId = clientId+ , oauthClientSecret = clientSecret+ , oauthOAuthorizeEndpoint = "https://bitbucket.com/site/oauth2/authorize" `withQuery`+ [ scopeParam "," scopes+ ] , oauthAccessTokenEndpoint = "https://bitbucket.com/site/oauth2/access_token" , oauthCallback = Nothing } -fetchBitbucketProfile :: Manager -> AccessToken -> IO (Creds m)+fetchBitbucketProfile :: Manager -> OAuth2Token -> IO (Creds m) fetchBitbucketProfile manager token = do- userResult <- authGetJSON manager token "https://api.bitbucket.com/2.0/user"- mailResult <- authGetJSON manager token "https://api.bitbucket.com/2.0/user/emails"+ userResult <- authGetJSON manager (accessToken token) "https://api.bitbucket.com/2.0/user"+ mailResult <- authGetJSON manager (accessToken token) "https://api.bitbucket.com/2.0/user/emails" case (userResult, mailResult) of (Right user, Right mails) -> return $ toCreds user (bitbucketEmails mails) token- (Left err, _) -> throwIO $ InvalidProfileResponse "bitbucket" err- (_, Left err) -> throwIO $ InvalidProfileResponse "bitbucket" err+ (Left err, _) -> throwIO $ invalidProfileResponse "bitbucket" err+ (_, Left err) -> throwIO $ invalidProfileResponse "bitbucket" err -toCreds :: BitbucketUser -> [BitbucketUserEmail] -> AccessToken -> Creds m+toCreds :: BitbucketUser -> [BitbucketUserEmail] -> OAuth2Token -> Creds m toCreds user userMails token = Creds { credsPlugin = "bitbucket" , credsIdent = T.pack $ show $ bitbucketUserId user@@ -131,7 +131,7 @@ [ ("email", bitbucketUserEmailAddress email) , ("login", bitbucketUserLogin user) , ("avatar_url", bitbucketLinkHref (bitbucketAvatarLink (bitbucketUserLinks user)))- , ("access_token", decodeUtf8 $ accessToken token)+ , ("access_token", atoken $ accessToken token) ] ++ maybeExtra "name" (bitbucketUserName user) ++ maybeExtra "location" (bitbucketUserLocation user)
Yesod/Auth/OAuth2/EveOnline.hs view
@@ -23,9 +23,7 @@ import Control.Exception.Lifted import Control.Monad (mzero) import Data.Aeson-import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Network.HTTP.Conduit (Manager) import Yesod.Auth import Yesod.Auth.OAuth2@@ -86,22 +84,25 @@ where oauth = OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://login.eveonline.com/oauth/authorize?response_type=code&scope=" <> T.intercalate " " scopes+ { oauthClientId = clientId+ , oauthClientSecret = clientSecret+ , oauthOAuthorizeEndpoint = "https://login.eveonline.com/oauth/authorize" `withQuery`+ [ ("response_type", "code")+ , scopeParam " " scopes+ ] , oauthAccessTokenEndpoint = "https://login.eveonline.com/oauth/token" , oauthCallback = Nothing } -fetchEveProfile :: Manager -> AccessToken -> IO (Creds m)+fetchEveProfile :: Manager -> OAuth2Token -> IO (Creds m) fetchEveProfile manager token = do- userResult <- authGetJSON manager token "https://login.eveonline.com/oauth/verify"+ userResult <- authGetJSON manager (accessToken token) $ "https://login.eveonline.com/oauth/verify" case userResult of Right user -> return $ toCreds user token- Left err-> throwIO $ InvalidProfileResponse "eveonline" err+ Left err-> throwIO $ invalidProfileResponse "eveonline" err -toCreds :: EveUser -> AccessToken -> Creds m+toCreds :: EveUser -> OAuth2Token -> Creds m toCreds user token = Creds { credsPlugin = "eveonline" , credsIdent = T.pack $ show $ eveCharOwnerHash user@@ -110,6 +111,6 @@ , ("charId", T.pack . show . eveCharId $ user) , ("tokenType", eveTokenType user) , ("expires", eveUserExpire user)- , ("accessToken", decodeUtf8 . accessToken $ token)+ , ("accessToken", atoken $ accessToken token) ] }
Yesod/Auth/OAuth2/Github.hs view
@@ -23,9 +23,7 @@ import Data.Aeson import Data.Maybe (fromMaybe) import Data.List (find)-import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Network.HTTP.Conduit (Manager) import Yesod.Auth import Yesod.Auth.OAuth2@@ -78,25 +76,27 @@ oauth2GithubScoped clientId clientSecret scopes = authOAuth2 "github" oauth fetchGithubProfile where oauth = OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://github.com/login/oauth/authorize?scope=" <> T.intercalate "," scopes+ { oauthClientId = clientId+ , oauthClientSecret = clientSecret+ , oauthOAuthorizeEndpoint = "https://github.com/login/oauth/authorize" `withQuery`+ [ scopeParam "," scopes+ ] , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token" , oauthCallback = Nothing } -fetchGithubProfile :: Manager -> AccessToken -> IO (Creds m)+fetchGithubProfile :: Manager -> OAuth2Token -> IO (Creds m) fetchGithubProfile manager token = do- userResult <- authGetJSON manager token "https://api.github.com/user"- mailResult <- authGetJSON manager token "https://api.github.com/user/emails"+ userResult <- authGetJSON manager (accessToken token) "https://api.github.com/user"+ mailResult <- authGetJSON manager (accessToken token) "https://api.github.com/user/emails" case (userResult, mailResult) of (Right _, Right []) -> throwIO $ InvalidProfileResponse "github" "no mail address for user" (Right user, Right mails) -> return $ toCreds user mails token- (Left err, _) -> throwIO $ InvalidProfileResponse "github" err- (_, Left err) -> throwIO $ InvalidProfileResponse "github" err+ (Left err, _) -> throwIO $ invalidProfileResponse "github" err+ (_, Left err) -> throwIO $ invalidProfileResponse "github" err -toCreds :: GithubUser -> [GithubUserEmail] -> AccessToken -> Creds m+toCreds :: GithubUser -> [GithubUserEmail] -> OAuth2Token -> Creds m toCreds user userMails token = Creds { credsPlugin = "github" , credsIdent = T.pack $ show $ githubUserId user@@ -104,7 +104,7 @@ [ ("email", githubUserEmailAddress email) , ("login", githubUserLogin user) , ("avatar_url", githubUserAvatarUrl user)- , ("access_token", decodeUtf8 $ accessToken token)+ , ("access_token", atoken $ accessToken token) ] ++ maybeExtra "name" (githubUserName user) ++ maybeExtra "public_email" (githubUserPublicEmail user)
Yesod/Auth/OAuth2/Google.hs view
@@ -30,13 +30,10 @@ import Data.Aeson import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Network.HTTP.Conduit (Manager) import Yesod.Auth import Yesod.Auth.OAuth2 -import qualified Data.Text as T- -- | Auth with Google -- -- Requests @openid@ and @email@ scopes and uses email as the @'Creds'@@@ -67,7 +64,7 @@ -- See @'emailUid'@ and @'googleUid'@. -- oauth2GoogleScopedWithCustomId :: YesodAuth m- => (GoogleUser -> AccessToken -> Creds m)+ => (GoogleUser -> OAuth2Token -> Creds m) -- ^ A function to generate the credentials -> [Text] -- ^ List of scopes to request -> Text -- ^ Client ID@@ -78,20 +75,21 @@ where oauth = OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint = encodeUtf8- $ "https://accounts.google.com/o/oauth2/auth?scope=" <> T.intercalate "+" scopes+ { oauthClientId = clientId+ , oauthClientSecret = clientSecret+ , oauthOAuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" `withQuery`+ [ scopeParam "+" scopes+ ] , oauthAccessTokenEndpoint = "https://www.googleapis.com/oauth2/v3/token" , oauthCallback = Nothing } -fetchGoogleProfile :: (GoogleUser -> AccessToken -> Creds m) -> Manager -> AccessToken -> IO (Creds m)+fetchGoogleProfile :: (GoogleUser -> OAuth2Token -> Creds m) -> Manager -> OAuth2Token -> IO (Creds m) fetchGoogleProfile toCreds manager token = do- userInfo <- authGetJSON manager token "https://www.googleapis.com/oauth2/v3/userinfo"+ userInfo <- authGetJSON manager (accessToken token) "https://www.googleapis.com/oauth2/v3/userinfo" case userInfo of Right user -> return $ toCreds user token- Left err -> throwIO $ InvalidProfileResponse "google" err+ Left err -> throwIO $ invalidProfileResponse "google" err data GoogleUser = GoogleUser { googleUserId :: Text@@ -116,14 +114,14 @@ parseJSON _ = mzero -- | Build a @'Creds'@ using the user's google-uid as the identifier-googleUid :: GoogleUser -> AccessToken -> Creds m+googleUid :: GoogleUser -> OAuth2Token -> Creds m googleUid = uidBuilder $ ("google-uid:" <>) . googleUserId -- | Build a @'Creds'@ using the user's email as the identifier-emailUid :: GoogleUser -> AccessToken -> Creds m+emailUid :: GoogleUser -> OAuth2Token -> Creds m emailUid = uidBuilder googleUserEmail -uidBuilder :: (GoogleUser -> Text) -> GoogleUser -> AccessToken -> Creds m+uidBuilder :: (GoogleUser -> Text) -> GoogleUser -> OAuth2Token -> Creds m uidBuilder f user token = Creds { credsPlugin = "google" , credsIdent = f user@@ -133,7 +131,7 @@ , ("given_name", googleUserGivenName user) , ("family_name", googleUserFamilyName user) , ("avatar_url", googleUserPicture user)- , ("access_token", decodeUtf8 $ accessToken token)+ , ("access_token", atoken $ accessToken token) ] ++ maybeExtra "hosted_domain" (googleUserHostedDomain user) }
Yesod/Auth/OAuth2/Nylas.hs view
@@ -13,16 +13,14 @@ import Control.Monad (mzero) import Control.Exception.Lifted (throwIO) import Data.Aeson (FromJSON, Value(..), parseJSON, decode, (.:))-import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Client (applyBasicAuth, httpLbs, parseRequest, responseBody, responseStatus) import Network.HTTP.Conduit (Manager) import Yesod.Auth (Creds(..), YesodAuth, AuthPlugin)-import Yesod.Auth.OAuth2 (OAuth2(..), AccessToken(..),- YesodOAuth2Exception(InvalidProfileResponse),- authOAuth2)+import Yesod.Auth.OAuth2+ import qualified Network.HTTP.Types as HT data NylasAccount = NylasAccount@@ -48,18 +46,19 @@ -> AuthPlugin m oauth2Nylas clientId clientSecret = authOAuth2 "nylas" oauth fetchCreds where- authorizeUrl = encodeUtf8 $ "https://api.nylas.com/oauth/authorize" <>- "?response_type=code&scope=email&client_id=" <> clientId- oauth = OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint = authorizeUrl+ { oauthClientId = clientId+ , oauthClientSecret = clientSecret+ , oauthOAuthorizeEndpoint = "https://api.nylas.com/oauth/authorize" `withQuery`+ [ ("response_type", "code")+ , ("scope", "email")+ , ("client_id", encodeUtf8 clientId)+ ] , oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token" , oauthCallback = Nothing } -fetchCreds :: Manager -> AccessToken -> IO (Creds a)+fetchCreds :: Manager -> OAuth2Token -> IO (Creds a) fetchCreds manager token = do req <- authorize <$> parseRequest "https://api.nylas.com/account" resp <- httpLbs req manager@@ -69,11 +68,11 @@ Nothing -> throwIO parseFailure else throwIO requestFailure where- authorize = applyBasicAuth (accessToken token) ""+ authorize = applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) "" parseFailure = InvalidProfileResponse "nylas" "failed to parse account" requestFailure = InvalidProfileResponse "nylas" "failed to get account" -toCreds :: NylasAccount -> AccessToken -> Creds a+toCreds :: NylasAccount -> OAuth2Token -> Creds a toCreds ns token = Creds { credsPlugin = "nylas" , credsIdent = nylasAccountId ns@@ -82,6 +81,6 @@ , ("name", nylasAccountName ns) , ("provider", nylasAccountProvider ns) , ("organization_unit", nylasAccountOrganizationUnit ns)- , ("access_token", decodeUtf8 $ accessToken token)+ , ("access_token", atoken $ accessToken token) ] }
Yesod/Auth/OAuth2/Salesforce.hs view
@@ -24,9 +24,7 @@ import Control.Exception.Lifted import Control.Monad (mzero) import Data.Aeson-import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Network.HTTP.Conduit (Manager) import Yesod.Auth import Yesod.Auth.OAuth2@@ -51,19 +49,21 @@ authOAuth2 svcName oauth fetchSalesforceUser where oauth = OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://login.salesforce.com/services/oauth2/authorize?scope=" <> T.intercalate " " scopes+ { 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 -> AccessToken -> IO (Creds m)+fetchSalesforceUser :: Manager -> OAuth2Token -> IO (Creds m) fetchSalesforceUser manager token = do- result <- authGetJSON manager token "https://login.salesforce.com/services/oauth2/userinfo"+ 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+ Left err -> throwIO $ invalidProfileResponse svcName err svcNameSb :: Text svcNameSb = "salesforce-sandbox"@@ -84,19 +84,21 @@ authOAuth2 svcNameSb oauth fetchSalesforceSandboxUser where oauth = OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://test.salesforce.com/services/oauth2/authorize?scope=" <> T.intercalate " " scopes+ { 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 -> AccessToken -> IO (Creds m)+fetchSalesforceSandboxUser :: Manager -> OAuth2Token -> IO (Creds m) fetchSalesforceSandboxUser manager token = do- result <- authGetJSON manager token "https://test.salesforce.com/services/oauth2/userinfo"+ 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+ Left err -> throwIO $ invalidProfileResponse svcNameSb err data User = User { userId :: Text@@ -130,7 +132,7 @@ parseJSON _ = mzero -toCreds :: Text -> User -> AccessToken -> Creds m+toCreds :: Text -> User -> OAuth2Token -> Creds m toCreds name user token = Creds { credsPlugin = name , credsIdent = userId user@@ -144,9 +146,9 @@ , ("time_zone", userTimeZone user) , ("avatar_url", userPicture user) , ("rest_url", userRestUrl user)- , ("access_token", decodeUtf8 $ accessToken token)+ , ("access_token", atoken $ accessToken token) ]- ++ maybeExtra "refresh_token" (decodeUtf8 <$> refreshToken token)+ ++ maybeExtra "refresh_token" (rtoken <$> refreshToken token) ++ maybeExtra "expires_in" ((T.pack . show) <$> expiresIn token) ++ maybeExtra "phone_number" (userPhone user) }
Yesod/Auth/OAuth2/Slack.hs view
@@ -18,12 +18,10 @@ import Control.Exception.Lifted (throwIO) import Data.Maybe (catMaybes)-import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Conduit (Manager) -import qualified Data.Text as Text import qualified Network.HTTP.Conduit as HTTP data SlackScope@@ -86,39 +84,37 @@ authOAuth2 "slack" oauth fetchSlackProfile where oauth = OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint =- encodeUtf8- $ "https://slack.com/oauth/authorize?scope="- <> Text.intercalate "," scopeTexts+ { oauthClientId = clientId+ , oauthClientSecret = clientSecret+ , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize" `withQuery`+ [ scopeParam "," $ "identity.basic" : map scopeText scopes+ ] , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access" , oauthCallback = Nothing }- scopeTexts = "identity.basic":map scopeText scopes scopeText :: SlackScope -> Text scopeText SlackEmailScope = "identity.email" scopeText SlackTeamScope = "identity.team" scopeText SlackAvatarScope = "identity.avatar" -fetchSlackProfile :: Manager -> AccessToken -> IO (Creds m)+fetchSlackProfile :: Manager -> OAuth2Token -> IO (Creds m) fetchSlackProfile manager token = do request- <- HTTP.setQueryString [("token", Just $ accessToken token)]- <$> HTTP.parseUrl "https://slack.com/api/users.identity"+ <- HTTP.setQueryString [("token", Just $ encodeUtf8 $ atoken $ accessToken token)]+ <$> HTTP.parseUrlThrow "https://slack.com/api/users.identity" body <- HTTP.responseBody <$> HTTP.httpLbs request manager case eitherDecode body of Left _ -> throwIO $ InvalidProfileResponse "slack" body Right u -> return $ toCreds u token -toCreds :: SlackUser -> AccessToken -> Creds m+toCreds :: SlackUser -> OAuth2Token -> Creds m toCreds user token = Creds { credsPlugin = "slack" , credsIdent = slackUserId user , credsExtra = catMaybes [ Just ("name", slackUserName user)- , Just ("access_token", decodeUtf8 $ accessToken token)+ , Just ("access_token", atoken $ accessToken token) , (,) <$> pure "email" <*> slackUserEmail user , (,) <$> pure "avatar" <*> slackUserAvatarUrl user , (,) <$> pure "team_name" <*> (slackTeamName <$> slackUserTeam user)
Yesod/Auth/OAuth2/Spotify.hs view
@@ -15,14 +15,12 @@ import Control.Monad (mzero) import Data.Aeson-import Data.ByteString (ByteString) import Data.Maybe import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Yesod.Auth import Yesod.Auth.OAuth2 -import qualified Data.ByteString as B import qualified Data.Text as T data SpotifyUserImage = SpotifyUserImage@@ -66,13 +64,15 @@ oauth2Spotify :: YesodAuth m => Text -- ^ Client ID -> Text -- ^ Client Secret- -> [ByteString] -- ^ Scopes+ -> [Text] -- ^ Scopes -> AuthPlugin m oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify" OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret- , oauthOAuthorizeEndpoint = B.append "https://accounts.spotify.com/authorize?scope=" (B.intercalate "%20" scope)+ { oauthClientId = clientId+ , oauthClientSecret = clientSecret+ , oauthOAuthorizeEndpoint = "https://accounts.spotify.com/authorize" `withQuery`+ [ ("scope", encodeUtf8 $ T.intercalate " " scope)+ ] , oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token" , oauthCallback = Nothing }
Yesod/Auth/OAuth2/Upcase.hs view
@@ -20,7 +20,6 @@ import Control.Monad (mzero) import Data.Aeson import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8) import Yesod.Auth import Yesod.Auth.OAuth2 import qualified Data.Text as T@@ -55,8 +54,8 @@ -> AuthPlugin m oauth2Upcase clientId clientSecret = authOAuth2 "upcase" OAuth2- { oauthClientId = encodeUtf8 clientId- , oauthClientSecret = encodeUtf8 clientSecret+ { oauthClientId = clientId+ , oauthClientSecret = clientSecret , oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize" , oauthAccessTokenEndpoint = "http://upcase.com/oauth/token" , oauthCallback = Nothing
yesod-auth-oauth2.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-oauth2-version: 0.2.4+version: 0.3.0 license: BSD3 license-file: LICENSE author: Tom Streller@@ -31,7 +31,7 @@ , http-client >= 0.4.0 && < 0.6 , http-conduit >= 2.0 && < 3.0 , http-types >= 0.8 && < 0.10- , aeson >= 0.6 && < 1.1+ , aeson >= 0.6 && < 1.2 , yesod-core >= 1.2 && < 1.5 , authenticate >= 1.3.2.7 && < 1.4 , random@@ -39,9 +39,11 @@ , text >= 0.7 && < 2.0 , yesod-form >= 1.3 && < 1.5 , transformers >= 0.2.2 && < 0.6- , hoauth2 >= 0.4.7 && < 0.6+ , hoauth2 >= 1.3.0 && < 1.4 , lifted-base >= 0.2 && < 0.4- , vector >= 0.10 && < 0.12+ , vector >= 0.10 && < 0.13+ , uri-bytestring+ , microlens exposed-modules: Yesod.Auth.OAuth2 Yesod.Auth.OAuth2.Github@@ -54,6 +56,8 @@ Yesod.Auth.OAuth2.Salesforce Yesod.Auth.OAuth2.Bitbucket Yesod.Auth.OAuth2.BattleNet+ URI.ByteString.Extension+ -- ^ exposed for testing ghc-options: -Wall @@ -84,6 +88,7 @@ build-depends: base , yesod-auth-oauth2 , hspec+ , uri-bytestring source-repository head type: git