Create properly-named GitHub module

This commit is contained in:
patrick brisbin 2018-07-28 12:12:33 -04:00
parent 44c05d7a2d
commit c86fa6de13
2 changed files with 57 additions and 43 deletions

View File

@ -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
}

View File

@ -1,53 +1,14 @@
{-# 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.GitHub
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
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