diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -39,7 +39,8 @@ import Yesod.Auth.OAuth2.BattleNet import Yesod.Auth.OAuth2.Bitbucket import Yesod.Auth.OAuth2.EveOnline -import Yesod.Auth.OAuth2.Github +import Yesod.Auth.OAuth2.GitHub +import Yesod.Auth.OAuth2.GitLab import Yesod.Auth.OAuth2.Google import Yesod.Auth.OAuth2.Nylas import Yesod.Auth.OAuth2.Salesforce @@ -134,7 +135,8 @@ [ loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET" , loadPlugin oauth2Bitbucket "BITBUCKET" , loadPlugin (oauth2Eve Plain) "EVE_ONLINE" - , loadPlugin oauth2Github "GITHUB" + , loadPlugin oauth2GitHub "GITHUB" + , loadPlugin oauth2GitLab "GITLAB" , loadPlugin oauth2Google "GOOGLE" , loadPlugin oauth2Nylas "NYLAS" , loadPlugin oauth2Salesforce "SALES_FORCE" 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 @@ -49,5 +49,8 @@ (Just $ Authority Nothing h Nothing) (\a -> Just $ a & authorityHostL .~ h) +withPath :: URIRef a -> ByteString -> URIRef a +withPath u p = u & pathL .~ p + withQuery :: URIRef a -> [(ByteString, ByteString)] -> URIRef a withQuery u q = u & (queryL . queryPairsL) %~ (++ q) 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 @@ -19,6 +19,7 @@ -- * Reading our @'credsExtra'@ keys , getAccessToken + , getRefreshToken , getUserResponse , getUserResponseJSON ) where @@ -62,21 +63,25 @@ where login tm = [whamlet|^{widget}|] --- | Read from the values set via @'setExtra'@ +-- | Read the @'AccessToken'@ from the values set via @'setExtra'@ getAccessToken :: Creds m -> Maybe AccessToken getAccessToken = (AccessToken <$>) . lookup "accessToken" . credsExtra --- | Read from the values set via @'setExtra'@ +-- | 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 + +-- | Read the original profile response from the values set via @'setExtra'@ getUserResponse :: Creds m -> Maybe ByteString getUserResponse = (fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra --- | Read from the values set via @'setExtra'@, decode as JSON --- --- This is unsafe if the key is missing, but safe with respect to parsing --- errors. --- +-- | @'getUserResponse'@, and decode as JSON getUserResponseJSON :: FromJSON a => Creds m -> Either String a getUserResponseJSON = eitherDecode <=< note "userResponse key not present" . getUserResponse diff --git a/src/Yesod/Auth/OAuth2/GitHub.hs b/src/Yesod/Auth/OAuth2/GitHub.hs new file mode 100644 --- /dev/null +++ b/src/Yesod/Auth/OAuth2/GitHub.hs @@ -0,0 +1,53 @@ +{-# 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 + ) where + +import Yesod.Auth.OAuth2.Prelude + +import qualified Data.Text as T + +newtype User = User Int + +instance FromJSON User where + parseJSON = withObject "User" $ \o -> User + <$> o .: "id" + +pluginName :: Text +pluginName = "github" + +defaultScopes :: [Text] +defaultScopes = ["user:email"] + +oauth2GitHub :: YesodAuth m => Text -> Text -> AuthPlugin m +oauth2GitHub = oauth2GitHubScoped defaultScopes + +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" + + pure Creds + { credsPlugin = pluginName + , credsIdent = T.pack $ show userId + , credsExtra = setExtra token userResponse + } + where + oauth2 = OAuth2 + { oauthClientId = clientId + , oauthClientSecret = clientSecret + , oauthOAuthorizeEndpoint = "https://github.com/login/oauth/authorize" `withQuery` + [ scopeParam "," scopes + ] + , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token" + , oauthCallback = Nothing + } diff --git a/src/Yesod/Auth/OAuth2/GitLab.hs b/src/Yesod/Auth/OAuth2/GitLab.hs new file mode 100644 --- /dev/null +++ b/src/Yesod/Auth/OAuth2/GitLab.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings #-} +module Yesod.Auth.OAuth2.GitLab + ( oauth2GitLab + , oauth2GitLabHostScopes + , defaultHost + , defaultScopes + ) where + +import Yesod.Auth.OAuth2.Prelude + +import qualified Data.Text as T + +newtype User = User Int + +instance FromJSON User where + parseJSON = withObject "User" $ \o -> User + <$> o .: "id" + +pluginName :: Text +pluginName = "gitlab" + +defaultHost :: URI +defaultHost = "https://gitlab.com" + +defaultScopes :: [Text] +defaultScopes = ["read_user"] + +-- | Authorize with @gitlab.com@ and @[\"read_user\"]@ +-- +-- To customize either of these values, use @'oauth2GitLabHostScopes'@ and pass +-- the default for the argument not being customized. Note that we require at +-- least @read_user@, so we can request the credentials identifier. +-- +-- > oauth2GitLabHostScopes defaultHost ["api", "read_user"] +-- > oauth2GitLabHostScopes "https://gitlab.example.com" defaultScopes +-- +oauth2GitLab :: YesodAuth m => Text -> Text -> AuthPlugin m +oauth2GitLab = oauth2GitLabHostScopes defaultHost defaultScopes + +oauth2GitLabHostScopes :: YesodAuth m => URI -> [Text] -> Text -> Text -> AuthPlugin m +oauth2GitLabHostScopes host scopes clientId clientSecret = + authOAuth2 pluginName oauth2 $ \manager token -> do + (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 + } + where + oauth2 = OAuth2 + { oauthClientId = clientId + , oauthClientSecret = clientSecret + , oauthOAuthorizeEndpoint = host + `withPath` "/oauth/authorize" + `withQuery` [ scopeParam " " scopes ] + , oauthAccessTokenEndpoint = host `withPath` "/oauth/token" + , oauthCallback = Nothing + } 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,53 +1,15 @@ -{-# LANGUAGE OverloadedStrings #-} --- | --- --- OAuth2 plugin for http://github.com --- --- * Authenticates against github --- * Uses github user id as credentials identifier --- module Yesod.Auth.OAuth2.Github + {-# DEPRECATED "Please use Yesod.Auth.OAuth2.GitHub (GitHub, not Github)" #-} ( oauth2Github , oauth2GithubScoped ) where -import Yesod.Auth.OAuth2.Prelude -import qualified Data.Text as T - -newtype User = User Int - -instance FromJSON User where - parseJSON = withObject "User" $ \o -> User - <$> o .: "id" - -pluginName :: Text -pluginName = "github" - -defaultScopes :: [Text] -defaultScopes = ["user:email"] +import Yesod.Auth.OAuth2.GitHub +import Yesod.Auth.OAuth2.Prelude oauth2Github :: YesodAuth m => Text -> Text -> AuthPlugin m -oauth2Github = oauth2GithubScoped defaultScopes +oauth2Github = oauth2GitHub 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" - - pure Creds - { credsPlugin = pluginName - , credsIdent = T.pack $ show userId - , credsExtra = setExtra token userResponse - } - where - oauth2 = OAuth2 - { oauthClientId = clientId - , oauthClientSecret = clientSecret - , oauthOAuthorizeEndpoint = "https://github.com/login/oauth/authorize" `withQuery` - [ scopeParam "," scopes - ] - , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token" - , oauthCallback = Nothing - } +oauth2GithubScoped = oauth2GitHubScoped 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 @@ -114,13 +114,18 @@ -- | Construct part of @'credsExtra'@ -- --- Sets the following keys: +-- Always the following keys: -- -- - @accessToken@: to support follow-up requests -- - @userResponse@: to support getting additional information -- +-- 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) diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.20.0. +-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- --- hash: 8ca8256c419d63fec8925743afe833bfa510d57bf4c9c3f50707f07ad619058a +-- hash: d660ecb1d27952349257ee5fad10d3bef5734b4e11646d20bec923fd77b1ae62 name: yesod-auth-oauth2 -version: 0.5.0.0 +version: 0.5.1.0 synopsis: OAuth 2.0 authentication plugins description: Library to authenticate with OAuth 2.0 for Yesod web applications. category: Web @@ -55,7 +55,9 @@ Yesod.Auth.OAuth2.Dispatch Yesod.Auth.OAuth2.ErrorResponse Yesod.Auth.OAuth2.EveOnline + Yesod.Auth.OAuth2.GitHub Yesod.Auth.OAuth2.Github + Yesod.Auth.OAuth2.GitLab Yesod.Auth.OAuth2.Google Yesod.Auth.OAuth2.Nylas Yesod.Auth.OAuth2.Prelude