diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,8 @@ -## [_Unreleased_](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.1.0...main) +## [_Unreleased_](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.1.1...main) + +## [v0.7.1.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.1.0...v0.7.1.1) + +- Support `mtl-2.3`, which no longer re-exports `Control.Monad` ## [v0.7.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.0.3...v0.7.1.0) diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -13,7 +13,7 @@ import Data.ByteString.Lazy (fromStrict, toStrict) import qualified Data.Map as M import Data.Maybe (fromJust) -import Data.String (IsString(fromString)) +import Data.String (IsString (fromString)) import Data.Text (Text, pack) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) @@ -46,13 +46,15 @@ , appAuthPlugins :: [AuthPlugin App] } -mkYesod "App" [parseRoutes| +mkYesod + "App" + [parseRoutes| / RootR GET /auth AuthR Auth getAuth |] instance Yesod App where - -- see https://github.com/thoughtbot/yesod-auth-oauth2/issues/87 + -- see https://github.com/thoughtbot/yesod-auth-oauth2/issues/87 approot = ApprootStatic "http://localhost:3000" instance YesodAuth App where @@ -65,9 +67,9 @@ -- Copy the Creds response into the session for viewing after authenticate c = do - mapM_ (uncurry setSession) - $ [("credsIdent", credsIdent c), ("credsPlugin", credsPlugin c)] - ++ credsExtra c + mapM_ (uncurry setSession) $ + [("credsIdent", credsIdent c), ("credsPlugin", credsPlugin c)] + ++ credsExtra c return $ Authenticated "1" @@ -80,23 +82,24 @@ getRootR :: Handler Html getRootR = do - sess <- getSession + sess <- getSession - let - prettify - = decodeUtf8 - . toStrict - . encodePretty - . fromJust - . decode @Value - . fromStrict + let + prettify = + decodeUtf8 + . toStrict + . encodePretty + . fromJust + . decode @Value + . fromStrict - mCredsIdent = decodeUtf8 <$> M.lookup "credsIdent" sess - mCredsPlugin = decodeUtf8 <$> M.lookup "credsPlugin" sess - mAccessToken = decodeUtf8 <$> M.lookup "accessToken" sess - mUserResponse = prettify <$> M.lookup "userResponse" sess + mCredsIdent = decodeUtf8 <$> M.lookup "credsIdent" sess + mCredsPlugin = decodeUtf8 <$> M.lookup "credsPlugin" sess + mAccessToken = decodeUtf8 <$> M.lookup "accessToken" sess + mUserResponse = prettify <$> M.lookup "userResponse" sess - defaultLayout [whamlet| + defaultLayout + [whamlet|

Yesod Auth OAuth2 Example

Log in @@ -123,32 +126,33 @@ azureTenant <- getEnv "AZURE_ADV2_TENANT_ID" appHttpManager <- newManager tlsManagerSettings - appAuthPlugins <- sequence + appAuthPlugins <- + sequence -- When Providers are added, add them here and update .env.example. -- Nothing else should need changing. -- -- FIXME: oauth2BattleNet is quite annoying! -- - [ loadPlugin oauth2AzureAD "AZURE_AD" - , loadPlugin (oauth2AzureADv2 $ pack azureTenant) "AZURE_ADV2" - , loadPlugin (oauth2Auth0Host $ fromString auth0Host) "AUTH0" - , loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET" - , loadPlugin oauth2Bitbucket "BITBUCKET" - , loadPlugin oauth2ClassLink "CLASSLINK" - , loadPlugin (oauth2Eve Plain) "EVE_ONLINE" - , loadPlugin oauth2GitHub "GITHUB" - , loadPlugin oauth2GitLab "GITLAB" - , loadPlugin oauth2Google "GOOGLE" - , loadPlugin oauth2Nylas "NYLAS" - , loadPlugin oauth2Salesforce "SALES_FORCE" - , loadPlugin oauth2Slack "SLACK" - , loadPlugin (oauth2Spotify []) "SPOTIFY" - , loadPlugin oauth2Twitch "TWITCH" - , loadPlugin oauth2WordPressDotCom "WORDPRESS_DOT_COM" - , loadPlugin oauth2Upcase "UPCASE" - ] + [ loadPlugin oauth2AzureAD "AZURE_AD" + , loadPlugin (oauth2AzureADv2 $ pack azureTenant) "AZURE_ADV2" + , loadPlugin (oauth2Auth0Host $ fromString auth0Host) "AUTH0" + , loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET" + , loadPlugin oauth2Bitbucket "BITBUCKET" + , loadPlugin oauth2ClassLink "CLASSLINK" + , loadPlugin (oauth2Eve Plain) "EVE_ONLINE" + , loadPlugin oauth2GitHub "GITHUB" + , loadPlugin oauth2GitLab "GITLAB" + , loadPlugin oauth2Google "GOOGLE" + , loadPlugin oauth2Nylas "NYLAS" + , loadPlugin oauth2Salesforce "SALES_FORCE" + , loadPlugin oauth2Slack "SLACK" + , loadPlugin (oauth2Spotify []) "SPOTIFY" + , loadPlugin oauth2Twitch "TWITCH" + , loadPlugin oauth2WordPressDotCom "WORDPRESS_DOT_COM" + , loadPlugin oauth2Upcase "UPCASE" + ] - return App { .. } + return App {..} where loadPlugin f prefix = do clientId <- getEnv $ prefix <> "_CLIENT_ID" diff --git a/src/Network/OAuth/OAuth2/Compat.hs b/src/Network/OAuth/OAuth2/Compat.hs --- a/src/Network/OAuth/OAuth2/Compat.hs +++ b/src/Network/OAuth/OAuth2/Compat.hs @@ -1,17 +1,17 @@ {-# LANGUAGE CPP #-} module Network.OAuth.OAuth2.Compat - ( OAuth2(..) - , OAuth2Result - , Errors - , authorizationUrl - , fetchAccessToken - , fetchAccessToken2 - , authGetBS + ( OAuth2 (..) + , OAuth2Result + , Errors + , authorizationUrl + , fetchAccessToken + , fetchAccessToken2 + , authGetBS -- * Re-exports - , module Network.OAuth.OAuth2 - ) where + , module Network.OAuth.OAuth2 + ) where import Data.ByteString.Lazy (ByteString) import Data.Text (Text) @@ -39,12 +39,12 @@ #endif data OAuth2 = OAuth2 - { oauth2ClientId :: Text - , oauth2ClientSecret :: Maybe Text - , oauth2AuthorizeEndpoint :: URIRef Absolute - , oauth2TokenEndpoint :: URIRef Absolute - , oauth2RedirectUri :: Maybe (URIRef Absolute) - } + { oauth2ClientId :: Text + , oauth2ClientSecret :: Maybe Text + , oauth2AuthorizeEndpoint :: URIRef Absolute + , oauth2TokenEndpoint :: URIRef Absolute + , oauth2RedirectUri :: Maybe (URIRef Absolute) + } #if MIN_VERSION_hoauth2(2,7,0) type Errors = TokenRequestError @@ -58,17 +58,17 @@ authorizationUrl = OAuth2.authorizationUrl . getOAuth2 fetchAccessToken - :: Manager - -> OAuth2 - -> ExchangeToken - -> IO (OAuth2Result Errors OAuth2Token) + :: Manager + -> OAuth2 + -> ExchangeToken + -> IO (OAuth2Result Errors OAuth2Token) fetchAccessToken = fetchAccessTokenBasic fetchAccessToken2 - :: Manager - -> OAuth2 - -> ExchangeToken - -> IO (OAuth2Result Errors OAuth2Token) + :: Manager + -> OAuth2 + -> ExchangeToken + -> IO (OAuth2Result Errors OAuth2Token) fetchAccessToken2 = fetchAccessTokenPost authGetBS :: Manager -> AccessToken -> URI -> IO (Either ByteString ByteString) @@ -141,12 +141,12 @@ -- directly. fetchAccessTokenBasic - :: Manager - -> OAuth2 - -> ExchangeToken - -> IO (OAuth2Result Errors OAuth2Token) + :: Manager + -> OAuth2 + -> ExchangeToken + -> IO (OAuth2Result Errors OAuth2Token) fetchAccessTokenBasic m o e = runOAuth2 $ f m (getOAuth2 o) e - where + where #if MIN_VERSION_hoauth2(2,6,0) f = OAuth2.fetchAccessTokenWithAuthMethod OAuth2.ClientSecretBasic #elif MIN_VERSION_hoauth2(2,3,0) @@ -156,12 +156,12 @@ #endif fetchAccessTokenPost - :: Manager - -> OAuth2 - -> ExchangeToken - -> IO (OAuth2Result Errors OAuth2Token) + :: Manager + -> OAuth2 + -> ExchangeToken + -> IO (OAuth2Result Errors OAuth2Token) fetchAccessTokenPost m o e = runOAuth2 $ f m (getOAuth2 o) e - where + where #if MIN_VERSION_hoauth2(2, 6, 0) f = OAuth2.fetchAccessTokenWithAuthMethod OAuth2.ClientSecretPost #elif MIN_VERSION_hoauth2(2,3,0) diff --git a/src/URI/ByteString/Extension.hs b/src/URI/ByteString/Extension.hs --- a/src/URI/ByteString/Extension.hs +++ b/src/URI/ByteString/Extension.hs @@ -1,9 +1,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + module URI.ByteString.Extension where import Data.ByteString (ByteString) -import Data.String (IsString(..)) +import Data.String (IsString (..)) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Lens.Micro @@ -41,9 +42,12 @@ 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) +withHost u h = + u + & authorityL + %~ maybe + (Just $ Authority Nothing h Nothing) + (\a -> Just $ a & authorityHostL .~ h) withPath :: URIRef a -> ByteString -> URIRef a withPath u p = u & pathL .~ p diff --git a/src/UnliftIO/Except.hs b/src/UnliftIO/Except.hs --- a/src/UnliftIO/Except.hs +++ b/src/UnliftIO/Except.hs @@ -1,9 +1,9 @@ {-# OPTIONS_GHC -Wno-orphans #-} -module UnliftIO.Except - () where +module UnliftIO.Except () where -import Control.Monad.Except +import Control.Monad ((<=<)) +import Control.Monad.Except (ExceptT (..), runExceptT) import UnliftIO instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where diff --git a/src/Yesod/Auth/OAuth2.hs b/src/Yesod/Auth/OAuth2.hs --- a/src/Yesod/Auth/OAuth2.hs +++ b/src/Yesod/Auth/OAuth2.hs @@ -1,18 +1,18 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} + -- | -- -- Generic OAuth2 plugin for Yesod -- -- See @"Yesod.Auth.OAuth2.GitHub"@ for example usage. --- module Yesod.Auth.OAuth2 - ( OAuth2(..) + ( OAuth2 (..) , FetchCreds , Manager - , OAuth2Token(..) - , Creds(..) + , OAuth2Token (..) + , Creds (..) , oauth2Url , authOAuth2 , authOAuth2Widget @@ -46,14 +46,12 @@ -- | Create an @'AuthPlugin'@ for the given OAuth2 provider -- -- Presents a generic @"Login via #{name}"@ link --- authOAuth2 :: YesodAuth m => Text -> OAuth2 -> FetchCreds m -> AuthPlugin m authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name -- | A version of 'authOAuth2' that uses 'fetchAccessToken2' -- -- See --- authOAuth2' :: YesodAuth m => Text -> OAuth2 -> FetchCreds m -> AuthPlugin m authOAuth2' name = authOAuth2Widget' [whamlet|Login via #{name}|] name @@ -61,7 +59,6 @@ -- -- Allows passing a custom widget for the login link. See @'oauth2Eve'@ for an -- example. --- authOAuth2Widget :: YesodAuth m => WidgetFor m () @@ -74,7 +71,6 @@ -- | A version of 'authOAuth2Widget' that uses 'fetchAccessToken2' -- -- See --- authOAuth2Widget' :: YesodAuth m => WidgetFor m () @@ -92,11 +88,13 @@ -> OAuth2 -> FetchCreds m -> AuthPlugin m -buildPlugin getToken widget name oauth getCreds = AuthPlugin - name - (dispatchAuthRequest name oauth getToken getCreds) - login - where login tm = [whamlet|^{widget}|] +buildPlugin getToken widget name oauth getCreds = + AuthPlugin + name + (dispatchAuthRequest name oauth getToken getCreds) + login + where + login tm = [whamlet|^{widget}|] -- | Read the @'AccessToken'@ from the values set via @'setExtra'@ getAccessToken :: Creds m -> Maybe AccessToken @@ -105,7 +103,6 @@ -- | Read the @'RefreshToken'@ from the values set via @'setExtra'@ -- -- N.B. not all providers supply this value. --- getRefreshToken :: Creds m -> Maybe RefreshToken getRefreshToken = (RefreshToken <$>) . lookup "refreshToken" . credsExtra diff --git a/src/Yesod/Auth/OAuth2/Auth0.hs b/src/Yesod/Auth/OAuth2/Auth0.hs --- a/src/Yesod/Auth/OAuth2/Auth0.hs +++ b/src/Yesod/Auth/OAuth2/Auth0.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- OAuth2 plugin for -- -- * Authenticates against specific auth0 tenant -- * Uses Auth0 user id (a.k.a [sub](https://auth0.com/docs/api/authentication#get-user-info)) as credentials identifier --- module Yesod.Auth.OAuth2.Auth0 ( oauth2Auth0HostScopes , oauth2Auth0Host @@ -13,8 +13,8 @@ import Data.Aeson as Aeson import qualified Data.Text as T -import Prelude import Yesod.Auth.OAuth2.Prelude +import Prelude -- | https://auth0.com/docs/api/authentication#get-user-info newtype User = User T.Text @@ -36,22 +36,25 @@ :: YesodAuth m => URI -> [Text] -> Text -> Text -> AuthPlugin m oauth2Auth0HostScopes host scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User uid, userResponse) <- authGetProfile - pluginName - manager - token - (host `withPath` "/userinfo") - pure Creds - { credsPlugin = pluginName - , credsIdent = uid - , credsExtra = setExtra token userResponse - } + (User uid, userResponse) <- + authGetProfile + pluginName + manager + token + (host `withPath` "/userinfo") + pure + Creds + { credsPlugin = pluginName + , credsIdent = uid + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - host `withPath` "/authorize" `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = host `withPath` "/oauth/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + host `withPath` "/authorize" `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = host `withPath` "/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/AzureAD.hs b/src/Yesod/Auth/OAuth2/AzureAD.hs --- a/src/Yesod/Auth/OAuth2/AzureAD.hs +++ b/src/Yesod/Auth/OAuth2/AzureAD.hs @@ -1,18 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- -- OAuth2 plugin for Azure AD. -- -- * Authenticates against Azure AD -- * Uses email as credentials identifier --- module Yesod.Auth.OAuth2.AzureAD ( oauth2AzureAD , oauth2AzureADScoped ) where -import Prelude import Yesod.Auth.OAuth2.Prelude +import Prelude newtype User = User Text @@ -31,26 +31,29 @@ oauth2AzureADScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2AzureADScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://graph.microsoft.com/v1.0/me" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://graph.microsoft.com/v1.0/me" - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://login.windows.net/common/oauth2/authorize" - `withQuery` [ scopeParam "," scopes - , ("resource", "https://graph.microsoft.com") - ] - , oauth2TokenEndpoint = "https://login.windows.net/common/oauth2/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://login.windows.net/common/oauth2/authorize" + `withQuery` [ scopeParam "," scopes + , ("resource", "https://graph.microsoft.com") + ] + , oauth2TokenEndpoint = "https://login.windows.net/common/oauth2/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/AzureADv2.hs b/src/Yesod/Auth/OAuth2/AzureADv2.hs --- a/src/Yesod/Auth/OAuth2/AzureADv2.hs +++ b/src/Yesod/Auth/OAuth2/AzureADv2.hs @@ -1,18 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- -- OAuth2 plugin for Azure AD using the new v2 endpoints. -- -- * Authenticates against Azure AD -- * Uses email as credentials identifier --- module Yesod.Auth.OAuth2.AzureADv2 ( oauth2AzureADv2 , oauth2AzureADv2Scoped ) where -import Prelude import Yesod.Auth.OAuth2.Prelude +import Prelude import Data.String import Data.Text (unpack) @@ -34,49 +34,55 @@ -- ^ Tenant Id -- -- If using a multi-tenant App, @common@ can be given here. - -- - -> Text -- ^ Client Id - -> Text -- ^ Client secret + -> Text + -- ^ Client Id + -> Text + -- ^ Client secret -> AuthPlugin m oauth2AzureADv2 = oauth2AzureADv2Scoped defaultScopes oauth2AzureADv2Scoped :: YesodAuth m - => [Text] -- ^ Scopes + => [Text] + -- ^ Scopes -> Text -- ^ Tenant Id -- -- If using a multi-tenant App, @common@ can be given here. - -- - -> Text -- ^ Client Id - -> Text -- ^ Client Secret + -> Text + -- ^ Client Id + -> Text + -- ^ Client Secret -> AuthPlugin m oauth2AzureADv2Scoped scopes tenantId clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://graph.microsoft.com/v1.0/me" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://graph.microsoft.com/v1.0/me" - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - tenantUrl "/authorize" `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = tenantUrl "/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + tenantUrl "/authorize" `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = tenantUrl "/token" + , oauth2RedirectUri = Nothing + } tenantUrl path = - fromString - $ "https://login.microsoftonline.com/" - <> unpack tenantId - <> "/oauth2/v2.0" - <> path + fromString $ + "https://login.microsoftonline.com/" + <> unpack tenantId + <> "/oauth2/v2.0" + <> path diff --git a/src/Yesod/Auth/OAuth2/BattleNet.hs b/src/Yesod/Auth/OAuth2/BattleNet.hs --- a/src/Yesod/Auth/OAuth2/BattleNet.hs +++ b/src/Yesod/Auth/OAuth2/BattleNet.hs @@ -7,7 +7,6 @@ -- * Authenticates against battle.net. -- * Uses user's id as credentials identifier. -- * Returns user's battletag in extras. --- module Yesod.Auth.OAuth2.BattleNet ( oauth2BattleNet , oAuth2BattleNet @@ -28,32 +27,37 @@ oauth2BattleNet :: YesodAuth m - => WidgetFor m () -- ^ Login widget - -> Text -- ^ User region (e.g. "eu", "cn", "us") - -> Text -- ^ Client ID - -> Text -- ^ Client Secret + => WidgetFor m () + -- ^ Login widget + -> Text + -- ^ User region (e.g. "eu", "cn", "us") + -> Text + -- ^ Client ID + -> Text + -- ^ Client Secret -> AuthPlugin m oauth2BattleNet widget region clientId clientSecret = authOAuth2Widget widget pluginName oauth2 $ \manager token -> do (User userId, userResponse) <- - authGetProfile pluginName manager token - $ fromRelative "https" (apiHost $ T.toLower region) "/account/user" + authGetProfile pluginName manager token $ + fromRelative "https" (apiHost $ T.toLower region) "/account/user" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where host = wwwHost $ T.toLower region - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = fromRelative "https" host "/oauth/authorize" - , oauth2TokenEndpoint = fromRelative "https" host "/oauth/token" - , oauth2RedirectUri = Nothing - } - + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = fromRelative "https" host "/oauth/authorize" + , oauth2TokenEndpoint = fromRelative "https" host "/oauth/token" + , oauth2RedirectUri = Nothing + } apiHost :: Text -> Host apiHost "cn" = "api.battlenet.com.cn" diff --git a/src/Yesod/Auth/OAuth2/Bitbucket.hs b/src/Yesod/Auth/OAuth2/Bitbucket.hs --- a/src/Yesod/Auth/OAuth2/Bitbucket.hs +++ b/src/Yesod/Auth/OAuth2/Bitbucket.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- -- OAuth2 plugin for http://bitbucket.com -- -- * Authenticates against bitbucket -- * Uses bitbucket uuid as credentials identifier --- module Yesod.Auth.OAuth2.Bitbucket ( oauth2Bitbucket , oauth2BitbucketScoped @@ -32,30 +32,33 @@ oauth2BitbucketScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2BitbucketScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://api.bitbucket.com/2.0/user" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://api.bitbucket.com/2.0/user" - pure Creds - { credsPlugin = pluginName - -- FIXME: Preserved bug. This should just be userId (it's already - -- a Text), but because this code was shipped, folks likely have - -- Idents in their database like @"\"...\""@, and if we fixed this - -- they would need migrating. We're keeping it for now as it's a - -- minor wart. Breaking typed APIs is one thing, causing data to go - -- invalid is another. - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , -- FIXME: Preserved bug. This should just be userId (it's already + -- a Text), but because this code was shipped, folks likely have + -- Idents in their database like @"\"...\""@, and if we fixed this + -- they would need migrating. We're keeping it for now as it's a + -- minor wart. Breaking typed APIs is one thing, causing data to go + -- invalid is another. + credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://bitbucket.com/site/oauth2/authorize" - `withQuery` [scopeParam "," scopes] - , oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://bitbucket.com/site/oauth2/authorize" + `withQuery` [scopeParam "," scopes] + , oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/ClassLink.hs b/src/Yesod/Auth/OAuth2/ClassLink.hs --- a/src/Yesod/Auth/OAuth2/ClassLink.hs +++ b/src/Yesod/Auth/OAuth2/ClassLink.hs @@ -26,24 +26,27 @@ oauth2ClassLinkScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2ClassLinkScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://nodeapi.classlink.com/v2/my/info" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://nodeapi.classlink.com/v2/my/info" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://launchpad.classlink.com/oauth2/v2/auth" - `withQuery` [scopeParam "," scopes] - , oauth2TokenEndpoint = "https://launchpad.classlink.com/oauth2/v2/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://launchpad.classlink.com/oauth2/v2/auth" + `withQuery` [scopeParam "," scopes] + , oauth2TokenEndpoint = "https://launchpad.classlink.com/oauth2/v2/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Dispatch.hs b/src/Yesod/Auth/OAuth2/Dispatch.hs --- a/src/Yesod/Auth/OAuth2/Dispatch.hs +++ b/src/Yesod/Auth/OAuth2/Dispatch.hs @@ -12,14 +12,15 @@ , dispatchAuthRequest ) where -import Control.Monad.Except +import Control.Monad (unless) +import Control.Monad.Except (MonadError (..)) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Conduit (Manager) import Network.OAuth.OAuth2.Compat -import UnliftIO.Exception import URI.ByteString.Extension +import UnliftIO.Exception import Yesod.Auth hiding (ServerError) import Yesod.Auth.OAuth2.DispatchError import Yesod.Auth.OAuth2.ErrorResponse @@ -29,21 +30,26 @@ -- | How to fetch an @'OAuth2Token'@ -- -- This will be 'fetchAccessToken' or 'fetchAccessToken2' --- -type FetchToken - = Manager -> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token) +type FetchToken = + Manager -> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token) -- | How to take an @'OAuth2Token'@ and retrieve user credentials type FetchCreds m = Manager -> OAuth2Token -> IO (Creds m) -- | Dispatch the various OAuth2 handshake routes dispatchAuthRequest - :: Text -- ^ Name - -> OAuth2 -- ^ Service details - -> FetchToken -- ^ How to get a token - -> FetchCreds m -- ^ How to get credentials - -> Text -- ^ Method - -> [Text] -- ^ Path pieces + :: Text + -- ^ Name + -> OAuth2 + -- ^ Service details + -> FetchToken + -- ^ How to get a token + -> FetchCreds m + -- ^ How to get credentials + -> Text + -- ^ Method + -> [Text] + -- ^ Path pieces -> AuthHandler m TypedContent dispatchAuthRequest name oauth2 _ _ "GET" ["forward"] = handleDispatchError $ dispatchForward name oauth2 @@ -55,7 +61,6 @@ -- -- 1. Set a random CSRF token in our session -- 2. Redirect to the Provider's authorization URL --- dispatchForward :: (MonadError DispatchError m, MonadAuthHandler site m) => Text @@ -71,7 +76,6 @@ -- 1. Verify the URL's CSRF token matches our session -- 2. Use the code parameter to fetch an AccessToken for the Provider -- 3. Use the AccessToken to construct a @'Creds'@ value for the Provider --- dispatchCallback :: (MonadError DispatchError m, MonadAuthHandler site m) => Text @@ -85,12 +89,13 @@ code <- requireGetParam "code" manager <- authHttpManager oauth2' <- withCallbackAndState name oauth2 csrf - token <- either (throwError . OAuth2ResultError) pure - =<< liftIO (getToken manager oauth2' $ ExchangeToken code) + token <- + either (throwError . OAuth2ResultError) pure + =<< liftIO (getToken manager oauth2' $ ExchangeToken code) creds <- liftIO (getCreds manager token) - `catch` (throwError . FetchCredsIOException) - `catch` (throwError . FetchCredsYesodOAuth2Exception) + `catch` (throwError . FetchCredsIOException) + `catch` (throwError . FetchCredsYesodOAuth2Exception) setCredsRedirect creds withCallbackAndState @@ -102,29 +107,30 @@ withCallbackAndState name oauth2 csrf = do uri <- ($ PluginR name ["callback"]) <$> getParentUrlRender callback <- maybe (throwError $ InvalidCallbackUri uri) pure $ fromText uri - pure oauth2 - { oauth2RedirectUri = Just callback - , oauth2AuthorizeEndpoint = - oauth2AuthorizeEndpoint oauth2 `withQuery` [("state", encodeUtf8 csrf)] - } + pure + oauth2 + { oauth2RedirectUri = Just callback + , oauth2AuthorizeEndpoint = + oauth2AuthorizeEndpoint oauth2 `withQuery` [("state", encodeUtf8 csrf)] + } getParentUrlRender :: MonadHandler m => m (Route (SubHandlerSite m) -> Text) getParentUrlRender = (.) <$> getUrlRender <*> getRouteToParent --- | Set a random, ~30-character value in the session +-- | Set a random, ~64-byte value in the session -- -- Some (but not all) providers decode a @+@ in the state token as a space when -- sending it back to us. We don't expect this and fail. And if we did code for -- it, we'd then fail on the providers that /don't/ do that. -- -- Therefore, we just exclude @+@ in our tokens, which means this function may --- return slightly less than 30 characters. --- +-- return slightly fewer than 64 bytes. setSessionCSRF :: MonadHandler m => Text -> m Text setSessionCSRF sessionKey = do csrfToken <- liftIO randomToken csrfToken <$ setSession sessionKey csrfToken - where randomToken = T.filter (/= '+') <$> randomText 64 + where + randomToken = T.filter (/= '+') <$> randomText 64 -- | Verify the callback provided the same CSRF token as in our session verifySessionCSRF @@ -133,9 +139,10 @@ token <- requireGetParam "state" sessionToken <- lookupSession sessionKey deleteSession sessionKey - token <$ unless - (sessionToken == Just token) - (throwError $ InvalidStateToken sessionToken token) + token + <$ unless + (sessionToken == Just token) + (throwError $ InvalidStateToken sessionToken token) requireGetParam :: (MonadError DispatchError m, MonadHandler m) => Text -> m Text diff --git a/src/Yesod/Auth/OAuth2/DispatchError.hs b/src/Yesod/Auth/OAuth2/DispatchError.hs --- a/src/Yesod/Auth/OAuth2/DispatchError.hs +++ b/src/Yesod/Auth/OAuth2/DispatchError.hs @@ -9,7 +9,7 @@ {-# LANGUAGE TypeFamilies #-} module Yesod.Auth.OAuth2.DispatchError - ( DispatchError(..) + ( DispatchError (..) , handleDispatchError , onDispatchError ) where @@ -26,34 +26,33 @@ import Yesod.Core hiding (ErrorResponse) data DispatchError - = MissingParameter Text - | InvalidStateToken (Maybe Text) Text - | InvalidCallbackUri Text - | OAuth2HandshakeError ErrorResponse - | OAuth2ResultError Errors - | FetchCredsIOException IOException - | FetchCredsYesodOAuth2Exception YesodOAuth2Exception - | OtherDispatchError Text - deriving stock Show - deriving anyclass Exception + = MissingParameter Text + | InvalidStateToken (Maybe Text) Text + | InvalidCallbackUri Text + | OAuth2HandshakeError ErrorResponse + | OAuth2ResultError Errors + | FetchCredsIOException IOException + | FetchCredsYesodOAuth2Exception YesodOAuth2Exception + | OtherDispatchError Text + deriving stock (Show) + deriving anyclass (Exception) -- | User-friendly message for any given 'DispatchError' -- -- Most of these are opaque to the user. The exception details are present for -- the server logs. --- dispatchErrorMessage :: DispatchError -> Text dispatchErrorMessage = \case MissingParameter name -> "Parameter '" <> name <> "' is required, but not present in the URL" - InvalidStateToken{} -> "State token is invalid, please try again" - InvalidCallbackUri{} -> + InvalidStateToken {} -> "State token is invalid, please try again" + InvalidCallbackUri {} -> "Callback URI was not valid, this server may be misconfigured (no approot)" OAuth2HandshakeError er -> "OAuth2 handshake failure: " <> erUserMessage er - OAuth2ResultError{} -> "Login failed, please try again" - FetchCredsIOException{} -> "Login failed, please try again" - FetchCredsYesodOAuth2Exception{} -> "Login failed, please try again" - OtherDispatchError{} -> "Login failed, please try again" + OAuth2ResultError {} -> "Login failed, please try again" + FetchCredsIOException {} -> "Login failed, please try again" + FetchCredsYesodOAuth2Exception {} -> "Login failed, please try again" + OtherDispatchError {} -> "Login failed, please try again" handleDispatchError :: MonadAuthHandler site m diff --git a/src/Yesod/Auth/OAuth2/ErrorResponse.hs b/src/Yesod/Auth/OAuth2/ErrorResponse.hs --- a/src/Yesod/Auth/OAuth2/ErrorResponse.hs +++ b/src/Yesod/Auth/OAuth2/ErrorResponse.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} + -- | OAuth callback error response -- -- --- module Yesod.Auth.OAuth2.ErrorResponse - ( ErrorResponse(..) + ( ErrorResponse (..) , erUserMessage - , ErrorName(..) + , ErrorName (..) , onErrorResponse , unknownError ) where @@ -17,22 +17,22 @@ import Yesod.Core (MonadHandler, lookupGetParam) data ErrorName - = InvalidRequest - | UnauthorizedClient - | AccessDenied - | UnsupportedResponseType - | InvalidScope - | ServerError - | TemporarilyUnavailable - | Unknown Text - deriving Show + = InvalidRequest + | UnauthorizedClient + | AccessDenied + | UnsupportedResponseType + | InvalidScope + | ServerError + | TemporarilyUnavailable + | Unknown Text + deriving (Show) data ErrorResponse = ErrorResponse { erName :: ErrorName , erDescription :: Maybe Text , erURI :: Maybe Text } - deriving Show + deriving (Show) -- | Textual value suitable for display to a User erUserMessage :: ErrorResponse -> Text @@ -48,13 +48,12 @@ unknownError :: Text -> ErrorResponse unknownError x = - ErrorResponse { erName = Unknown x, erDescription = Nothing, erURI = Nothing } + ErrorResponse {erName = Unknown x, erDescription = Nothing, erURI = Nothing} -- | Check query parameters for an error, if found run the given action -- -- The action is expected to use a short-circuit response function like -- @'permissionDenied'@, hence this returning @()@. --- onErrorResponse :: MonadHandler m => (ErrorResponse -> m a) -> m () onErrorResponse f = traverse_ f =<< checkErrorResponse diff --git a/src/Yesod/Auth/OAuth2/EveOnline.hs b/src/Yesod/Auth/OAuth2/EveOnline.hs --- a/src/Yesod/Auth/OAuth2/EveOnline.hs +++ b/src/Yesod/Auth/OAuth2/EveOnline.hs @@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} + -- | -- -- OAuth2 plugin for http://eveonline.com -- -- * Authenticates against eveonline -- * Uses EVEs unique account-user-char-hash as credentials identifier --- module Yesod.Auth.OAuth2.EveOnline ( oauth2Eve , oauth2EveScoped - , WidgetType(..) + , WidgetType (..) ) where import Yesod.Auth.OAuth2.Prelude @@ -24,23 +24,24 @@ parseJSON = withObject "User" $ \o -> User <$> o .: "CharacterOwnerHash" data WidgetType m - = Plain -- ^ Simple "Login via eveonline" text - | BigWhite - | SmallWhite - | BigBlack - | SmallBlack - | Custom (WidgetFor m ()) + = -- | Simple "Login via eveonline" text + Plain + | BigWhite + | SmallWhite + | BigBlack + | SmallBlack + | Custom (WidgetFor m ()) asWidget :: YesodAuth m => WidgetType m -> WidgetFor m () asWidget Plain = [whamlet|Login via eveonline|] asWidget BigWhite = [whamlet||] -asWidget BigBlack - = [whamlet||] -asWidget SmallWhite - = [whamlet||] -asWidget SmallBlack - = [whamlet||] +asWidget BigBlack = + [whamlet||] +asWidget SmallWhite = + [whamlet||] +asWidget SmallBlack = + [whamlet||] asWidget (Custom a) = a pluginName :: Text @@ -57,25 +58,28 @@ oauth2EveScoped scopes widgetType clientId clientSecret = authOAuth2Widget (asWidget widgetType) pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://login.eveonline.com/oauth/verify" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://login.eveonline.com/oauth/verify" - pure Creds - { credsPlugin = "eveonline" - -- FIXME: Preserved bug. See similar comment in Bitbucket provider. - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = "eveonline" + , -- FIXME: Preserved bug. See similar comment in Bitbucket provider. + credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://login.eveonline.com/oauth/authorize" - `withQuery` [("response_type", "code"), scopeParam " " scopes] - , oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://login.eveonline.com/oauth/authorize" + `withQuery` [("response_type", "code"), scopeParam " " scopes] + , oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Exception.hs b/src/Yesod/Auth/OAuth2/Exception.hs --- a/src/Yesod/Auth/OAuth2/Exception.hs +++ b/src/Yesod/Auth/OAuth2/Exception.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} module Yesod.Auth.OAuth2.Exception - ( YesodOAuth2Exception(..) + ( YesodOAuth2Exception (..) ) where import Control.Exception.Safe @@ -9,21 +9,18 @@ import Data.Text (Text) data YesodOAuth2Exception - = OAuth2Error Text ByteString - -- ^ HTTP error during OAuth2 handshake + = -- | HTTP error during OAuth2 handshake -- -- Plugin name and JSON-encoded @OAuth2Error@ from @hoauth2@. - -- - | JSONDecodingError Text String - -- ^ User profile was not as expected + OAuth2Error Text ByteString + | -- | User profile was not as expected -- -- Plugin name and Aeson parse error message. - -- - | GenericError Text String - -- ^ Other error conditions + JSONDecodingError Text String + | -- | Other error conditions -- -- Plugin name and error message. - -- - deriving (Show, Typeable) + GenericError Text String + deriving (Show, Typeable) instance Exception YesodOAuth2Exception diff --git a/src/Yesod/Auth/OAuth2/GitHub.hs b/src/Yesod/Auth/OAuth2/GitHub.hs --- a/src/Yesod/Auth/OAuth2/GitHub.hs +++ b/src/Yesod/Auth/OAuth2/GitHub.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- -- OAuth2 plugin for http://github.com -- -- * Authenticates against github -- * Uses github user id as credentials identifier --- module Yesod.Auth.OAuth2.GitHub ( oauth2GitHub , oauth2GitHubScoped @@ -32,24 +32,27 @@ oauth2GitHubScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2GitHubScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://api.github.com/user" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://api.github.com/user" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://github.com/login/oauth/authorize" - `withQuery` [scopeParam "," scopes] - , oauth2TokenEndpoint = "https://github.com/login/oauth/access_token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://github.com/login/oauth/authorize" + `withQuery` [scopeParam "," scopes] + , oauth2TokenEndpoint = "https://github.com/login/oauth/access_token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/GitLab.hs b/src/Yesod/Auth/OAuth2/GitLab.hs --- a/src/Yesod/Auth/OAuth2/GitLab.hs +++ b/src/Yesod/Auth/OAuth2/GitLab.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + module Yesod.Auth.OAuth2.GitLab ( oauth2GitLab , oauth2GitLabHostScopes @@ -32,7 +33,6 @@ -- -- > oauth2GitLabHostScopes defaultHost ["api", "read_user"] -- > oauth2GitLabHostScopes "https://gitlab.example.com" defaultScopes --- oauth2GitLab :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2GitLab = oauth2GitLabHostScopes defaultHost defaultScopes @@ -43,17 +43,19 @@ (User userId, userResponse) <- authGetProfile pluginName manager token $ host `withPath` "/api/v4/user" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - host `withPath` "/oauth/authorize" `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = host `withPath` "/oauth/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + host `withPath` "/oauth/authorize" `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = host `withPath` "/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Google.hs b/src/Yesod/Auth/OAuth2/Google.hs --- a/src/Yesod/Auth/OAuth2/Google.hs +++ b/src/Yesod/Auth/OAuth2/Google.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} + -- | -- -- OAuth2 plugin for http://www.google.com @@ -23,7 +24,6 @@ -- > updatedCreds = creds { credsIdent = email } -- > -- > -- continue normally with updatedCreds --- module Yesod.Auth.OAuth2.Google ( oauth2Google , oauth2GoogleWidget @@ -38,9 +38,10 @@ instance FromJSON User where parseJSON = - withObject "User" $ \o -> User - -- Required for data backwards-compatibility - <$> (("google-uid:" <>) <$> o .: "sub") + withObject "User" $ \o -> + User + -- Required for data backwards-compatibility + <$> (("google-uid:" <>) <$> o .: "sub") pluginName :: Text pluginName = "google" @@ -63,24 +64,27 @@ :: YesodAuth m => WidgetFor m () -> [Text] -> Text -> Text -> AuthPlugin m oauth2GoogleScopedWidget widget scopes clientId clientSecret = authOAuth2Widget widget pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://www.googleapis.com/oauth2/v3/userinfo" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://www.googleapis.com/oauth2/v3/userinfo" - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://accounts.google.com/o/oauth2/auth" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = "https://www.googleapis.com/oauth2/v3/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://accounts.google.com/o/oauth2/auth" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = "https://www.googleapis.com/oauth2/v3/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Nylas.hs b/src/Yesod/Auth/OAuth2/Nylas.hs --- a/src/Yesod/Auth/OAuth2/Nylas.hs +++ b/src/Yesod/Auth/OAuth2/Nylas.hs @@ -26,41 +26,45 @@ oauth2Nylas :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Nylas clientId clientSecret = authOAuth2 pluginName oauth $ \manager token -> do - req <- applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) "" - <$> parseRequest "https://api.nylas.com/account" + req <- + applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) "" + <$> parseRequest "https://api.nylas.com/account" resp <- httpLbs req manager let userResponse = responseBody resp -- FIXME: was this working? I'm 95% sure that the client will throw its -- own exception on unsuccessful status codes. - unless (HT.statusIsSuccessful $ responseStatus resp) - $ throwIO - $ YesodOAuth2Exception.GenericError pluginName - $ "Unsuccessful HTTP response: " - <> BL8.unpack userResponse + unless (HT.statusIsSuccessful $ responseStatus resp) $ + throwIO $ + YesodOAuth2Exception.GenericError pluginName $ + "Unsuccessful HTTP response: " + <> BL8.unpack userResponse either - (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) - (\(User userId) -> pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } - ) + (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) + ( \(User userId) -> + pure + Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } + ) $ eitherDecode userResponse where - oauth = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://api.nylas.com/oauth/authorize" - `withQuery` [ ("response_type", "code") - , ("client_id", encodeUtf8 clientId) - -- N.B. The scopes delimeter is unknown/untested. Verify that before - -- extracting this to an argument and offering a Scoped function. In - -- its current state, it doesn't matter because it's only one scope. - , scopeParam "," defaultScopes - ] - , oauth2TokenEndpoint = "https://api.nylas.com/oauth/token" - , oauth2RedirectUri = Nothing - } + oauth = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://api.nylas.com/oauth/authorize" + `withQuery` [ ("response_type", "code") + , ("client_id", encodeUtf8 clientId) + , -- N.B. The scopes delimeter is unknown/untested. Verify that before + -- extracting this to an argument and offering a Scoped function. In + -- its current state, it doesn't matter because it's only one scope. + scopeParam "," defaultScopes + ] + , oauth2TokenEndpoint = "https://api.nylas.com/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Prelude.hs b/src/Yesod/Auth/OAuth2/Prelude.hs --- a/src/Yesod/Auth/OAuth2/Prelude.hs +++ b/src/Yesod/Auth/OAuth2/Prelude.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} + -- | -- -- Modules and support functions required by most or all provider -- implementations. May also be useful for writing local providers. --- module Yesod.Auth.OAuth2.Prelude ( authGetProfile , scopeParam @@ -20,8 +20,8 @@ , (.:?) , (.=) , (<>) - , FromJSON(..) - , ToJSON(..) + , FromJSON (..) + , ToJSON (..) , eitherDecode , withObject @@ -29,22 +29,22 @@ , throwIO -- * OAuth2 - , OAuth2(..) - , OAuth2Token(..) - , AccessToken(..) - , RefreshToken(..) + , OAuth2 (..) + , OAuth2Token (..) + , AccessToken (..) + , RefreshToken (..) -- * HTTP , Manager -- * Yesod - , YesodAuth(..) - , AuthPlugin(..) - , Creds(..) + , YesodAuth (..) + , AuthPlugin (..) + , Creds (..) -- * Bytestring URI types , URI - , Host(..) + , Host (..) -- * Bytestring URI extensions , module URI.ByteString.Extension @@ -74,7 +74,6 @@ -- The response should be parsed only far enough to read the required -- @'credsIdent'@. Additional information should either be re-parsed by or -- fetched via additional requests by consumers. --- authGetProfile :: FromJSON a => Text @@ -101,7 +100,7 @@ -- | A tuple of @\"scope\"@ and the given scopes separated by a delimiter scopeParam :: Text -> [Text] -> (ByteString, ByteString) -scopeParam d = ("scope", ) . encodeUtf8 . T.intercalate d +scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d -- brittany-disable-next-binding @@ -115,10 +114,9 @@ -- May set the following keys: -- -- - @refreshToken@: if the provider supports refreshing the @accessToken@ --- setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)] setExtra token userResponse = - [ ("accessToken", atoken $ accessToken token) - , ("userResponse", decodeUtf8 $ BL.toStrict userResponse) - ] - <> maybe [] (pure . ("refreshToken", ) . rtoken) (refreshToken token) + [ ("accessToken", atoken $ accessToken token) + , ("userResponse", decodeUtf8 $ BL.toStrict userResponse) + ] + <> maybe [] (pure . ("refreshToken",) . rtoken) (refreshToken token) diff --git a/src/Yesod/Auth/OAuth2/Random.hs b/src/Yesod/Auth/OAuth2/Random.hs --- a/src/Yesod/Auth/OAuth2/Random.hs +++ b/src/Yesod/Auth/OAuth2/Random.hs @@ -5,7 +5,7 @@ ) where import Crypto.Random (MonadRandom, getRandomBytes) -import Data.ByteArray.Encoding (Base(Base64), convertToBase) +import Data.ByteArray.Encoding (Base (Base64), convertToBase) import Data.ByteString (ByteString) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8) @@ -13,7 +13,7 @@ randomText :: MonadRandom m => Int - -- ^ Size in Bytes (note necessarily characters) + -- ^ Size in Bytes (not necessarily characters) -> m Text randomText size = decodeUtf8 . convertToBase @ByteString Base64 <$> getRandomBytes size diff --git a/src/Yesod/Auth/OAuth2/Salesforce.hs b/src/Yesod/Auth/OAuth2/Salesforce.hs --- a/src/Yesod/Auth/OAuth2/Salesforce.hs +++ b/src/Yesod/Auth/OAuth2/Salesforce.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- -- OAuth2 plugin for http://login.salesforce.com -- -- * Authenticates against Salesforce (or sandbox) -- * Uses Salesforce user id as credentials identifier --- module Yesod.Auth.OAuth2.Salesforce ( oauth2Salesforce , oauth2SalesforceScoped @@ -30,47 +30,54 @@ 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" +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" +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 + -> 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 +salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSecret = + authOAuth2 name oauth2 $ \manager token -> do (User userId, userResponse) <- authGetProfile name manager token profileUri - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = tokenUri - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = tokenUri + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Slack.hs b/src/Yesod/Auth/OAuth2/Slack.hs --- a/src/Yesod/Auth/OAuth2/Slack.hs +++ b/src/Yesod/Auth/OAuth2/Slack.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- OAuth2 plugin for https://slack.com/ -- -- * Authenticates against slack -- * Uses slack user id as credentials identifier --- module Yesod.Auth.OAuth2.Slack - ( SlackScope(..) + ( SlackScope (..) , oauth2Slack , oauth2SlackScoped ) where @@ -14,14 +14,18 @@ import Yesod.Auth.OAuth2.Prelude import Network.HTTP.Client - (httpLbs, parseUrlThrow, responseBody, setQueryString) + ( httpLbs + , parseUrlThrow + , responseBody + , setQueryString + ) import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception data SlackScope - = SlackBasicScope - | SlackEmailScope - | SlackTeamScope - | SlackAvatarScope + = SlackBasicScope + | SlackEmailScope + | SlackTeamScope + | SlackAvatarScope scopeText :: SlackScope -> Text scopeText SlackBasicScope = "identity.basic" @@ -50,26 +54,30 @@ oauth2SlackScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do let param = encodeUtf8 $ atoken $ accessToken token - req <- setQueryString [("token", Just param)] - <$> parseUrlThrow "https://slack.com/api/users.identity" + req <- + setQueryString [("token", Just param)] + <$> parseUrlThrow "https://slack.com/api/users.identity" userResponse <- responseBody <$> httpLbs req manager either - (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) - (\(User userId) -> pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } - ) + (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName) + ( \(User userId) -> + pure + Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } + ) $ eitherDecode userResponse where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://slack.com/oauth/authorize" - `withQuery` [scopeParam "," $ map scopeText scopes] - , oauth2TokenEndpoint = "https://slack.com/api/oauth.access" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://slack.com/oauth/authorize" + `withQuery` [scopeParam "," $ map scopeText scopes] + , oauth2TokenEndpoint = "https://slack.com/api/oauth.access" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Spotify.hs b/src/Yesod/Auth/OAuth2/Spotify.hs --- a/src/Yesod/Auth/OAuth2/Spotify.hs +++ b/src/Yesod/Auth/OAuth2/Spotify.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- -- OAuth2 plugin for http://spotify.com --- module Yesod.Auth.OAuth2.Spotify ( oauth2Spotify ) where @@ -20,24 +20,27 @@ oauth2Spotify :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2Spotify scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://api.spotify.com/v1/me" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://api.spotify.com/v1/me" - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://accounts.spotify.com/authorize" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = "https://accounts.spotify.com/api/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://accounts.spotify.com/authorize" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = "https://accounts.spotify.com/api/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Twitch.hs b/src/Yesod/Auth/OAuth2/Twitch.hs --- a/src/Yesod/Auth/OAuth2/Twitch.hs +++ b/src/Yesod/Auth/OAuth2/Twitch.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- -- OAuth2 plugin for http://twitch.tv -- -- * Authenticates against twitch -- * Uses twitch user id as credentials identifier --- module Yesod.Auth.OAuth2.Twitch ( oauth2Twitch , oauth2TwitchScoped @@ -32,28 +32,31 @@ oauth2TwitchScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m oauth2TwitchScoped scopes clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://id.twitch.tv/oauth2/validate" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://id.twitch.tv/oauth2/validate" - pure Creds - { credsPlugin = pluginName - , credsIdent = userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://id.twitch.tv/oauth2/authorize" - `withQuery` [scopeParam " " scopes] - , oauth2TokenEndpoint = - "https://id.twitch.tv/oauth2/token" - `withQuery` [ ("client_id", T.encodeUtf8 clientId) - , ("client_secret", T.encodeUtf8 clientSecret) - ] - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://id.twitch.tv/oauth2/authorize" + `withQuery` [scopeParam " " scopes] + , oauth2TokenEndpoint = + "https://id.twitch.tv/oauth2/token" + `withQuery` [ ("client_id", T.encodeUtf8 clientId) + , ("client_secret", T.encodeUtf8 clientSecret) + ] + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/Upcase.hs b/src/Yesod/Auth/OAuth2/Upcase.hs --- a/src/Yesod/Auth/OAuth2/Upcase.hs +++ b/src/Yesod/Auth/OAuth2/Upcase.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} + -- | -- -- OAuth2 plugin for http://upcase.com -- -- * Authenticates against upcase -- * Uses upcase user id as credentials identifier --- module Yesod.Auth.OAuth2.Upcase ( oauth2Upcase ) where @@ -27,22 +27,25 @@ oauth2Upcase :: YesodAuth m => Text -> Text -> AuthPlugin m oauth2Upcase clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (User userId, userResponse) <- authGetProfile - pluginName - manager - token - "http://upcase.com/api/v1/me.json" + (User userId, userResponse) <- + authGetProfile + pluginName + manager + token + "http://upcase.com/api/v1/me.json" - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + pure + Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize" - , oauth2TokenEndpoint = "http://upcase.com/oauth/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize" + , oauth2TokenEndpoint = "http://upcase.com/oauth/token" + , oauth2RedirectUri = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/WordPressDotCom.hs b/src/Yesod/Auth/OAuth2/WordPressDotCom.hs --- a/src/Yesod/Auth/OAuth2/WordPressDotCom.hs +++ b/src/Yesod/Auth/OAuth2/WordPressDotCom.hs @@ -16,31 +16,35 @@ parseJSON = withObject "WpUser" $ \o -> WpUser <$> o .: "ID" oauth2WordPressDotCom - :: (YesodAuth m) - => Text -- ^ Client Id - -> Text -- ^ Client Secret + :: YesodAuth m + => Text + -- ^ Client Id + -> Text + -- ^ Client Secret -> AuthPlugin m oauth2WordPressDotCom clientId clientSecret = authOAuth2 pluginName oauth2 $ \manager token -> do - (WpUser userId, userResponse) <- authGetProfile - pluginName - manager - token - "https://public-api.wordpress.com/rest/v1/me/" - - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } + (WpUser userId, userResponse) <- + authGetProfile + pluginName + manager + token + "https://public-api.wordpress.com/rest/v1/me/" + pure + Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } where - oauth2 = OAuth2 - { oauth2ClientId = clientId - , oauth2ClientSecret = Just clientSecret - , oauth2AuthorizeEndpoint = - "https://public-api.wordpress.com/oauth2/authorize" - `withQuery` [scopeParam "," ["auth"]] - , oauth2TokenEndpoint = "https://public-api.wordpress.com/oauth2/token" - , oauth2RedirectUri = Nothing - } + oauth2 = + OAuth2 + { oauth2ClientId = clientId + , oauth2ClientSecret = Just clientSecret + , oauth2AuthorizeEndpoint = + "https://public-api.wordpress.com/oauth2/authorize" + `withQuery` [scopeParam "," ["auth"]] + , oauth2TokenEndpoint = "https://public-api.wordpress.com/oauth2/token" + , oauth2RedirectUri = Nothing + } diff --git a/test/URI/ByteString/ExtensionSpec.hs b/test/URI/ByteString/ExtensionSpec.hs --- a/test/URI/ByteString/ExtensionSpec.hs +++ b/test/URI/ByteString/ExtensionSpec.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} + module URI.ByteString.ExtensionSpec ( spec ) where @@ -61,9 +62,8 @@ uriWithQuery `shouldBe` [uri|http://example.com?foo=bar|] it "handles a URI with an existing query" $ do - let - uriWithQuery = - [uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")] + let uriWithQuery = + [uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")] uriWithQuery `shouldBe` [uri|http://example.com?foo=bar&baz=bat|] @@ -71,9 +71,8 @@ -- it's worthwhile to show that you don't (and can't) pre-sanitize when -- using this function. it "handles santization of the query" $ do - let - uriWithQuery = - [uri|http://example.com|] `withQuery` [("foo", "bar baz")] + let uriWithQuery = + [uri|http://example.com|] `withQuery` [("foo", "bar baz")] toText uriWithQuery `shouldBe` "http://example.com?foo=bar%20baz" diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: yesod-auth-oauth2 -version: 0.7.1.0 +version: 0.7.1.1 license: MIT license-file: LICENSE maintainer: engineering@freckle.com