diff --git a/example/Main.hs b/example/Main.hs index 5462acb..1ab80e1 100644 --- a/example/Main.hs +++ b/example/Main.hs @@ -40,6 +40,7 @@ import Yesod.Auth.OAuth2.BattleNet import Yesod.Auth.OAuth2.Bitbucket import Yesod.Auth.OAuth2.EveOnline 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 @@ -135,6 +136,7 @@ mkFoundation = do , loadPlugin oauth2Bitbucket "BITBUCKET" , loadPlugin (oauth2Eve Plain) "EVE_ONLINE" , 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 index 1c59aa3..a5931c0 100644 --- a/src/URI/ByteString/Extension.hs +++ b/src/URI/ByteString/Extension.hs @@ -49,5 +49,8 @@ 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 + withQuery :: URIRef a -> [(ByteString, ByteString)] -> URIRef a withQuery u q = u & (queryL . queryPairsL) %~ (++ q) diff --git a/src/Yesod/Auth/OAuth2/GitLab.hs b/src/Yesod/Auth/OAuth2/GitLab.hs new file mode 100644 index 0000000..0f07369 --- /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 + }