yesod-auth-oauth2/src/Yesod/Auth/OAuth2/GitLab.hs
patrick brisbin 28d2113674 Update to latest GHC, Stackage resolver, hoauth2
- Update to ghc-8.8 / lts-16.0
- Update to hoauth2 >= 1.11.0

  - authGetBS has pre-encoded errors a v1.9
  - oauthClientSecret is Maybe at v1.11

- Tweak non-default Resolvers as required
2020-08-24 10:49:14 -04:00

65 lines
1.9 KiB
Haskell

{-# 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 = Just clientSecret
, oauthOAuthorizeEndpoint =
host
`withPath` "/oauth/authorize"
`withQuery` [scopeParam " " scopes]
, oauthAccessTokenEndpoint = host `withPath` "/oauth/token"
, oauthCallback = Nothing
}