Skip to content

Commit

Permalink
Add custom scope and/or widget options to GitHub plugin
Browse files Browse the repository at this point in the history
  • Loading branch information
jaanisfehling authored Mar 1, 2024
1 parent 94ba2eb commit f9f7e1b
Showing 1 changed file with 16 additions and 4 deletions.
20 changes: 16 additions & 4 deletions src/Yesod/Auth/OAuth2/GitHub.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- |
--
Expand All @@ -8,12 +9,14 @@
-- * Uses github user id as credentials identifier
module Yesod.Auth.OAuth2.GitHub
( oauth2GitHub
, oauth2GitHubWidget
, oauth2GitHubScoped
, oauth2GitHubScopedWidget
) where

import Yesod.Auth.OAuth2.Prelude

import qualified Data.Text as T
import Yesod.Auth.OAuth2.Prelude
import Yesod.Core (WidgetFor, whamlet)

newtype User = User Int

Expand All @@ -29,9 +32,18 @@ defaultScopes = ["user:email"]
oauth2GitHub :: YesodAuth m => Text -> Text -> AuthPlugin m
oauth2GitHub = oauth2GitHubScoped defaultScopes

oauth2GitHubWidget
:: YesodAuth m => WidgetFor m () -> Text -> Text -> AuthPlugin m
oauth2GitHubWidget widget = oauth2GitHubScopedWidget widget defaultScopes

oauth2GitHubScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
oauth2GitHubScoped scopes clientId clientSecret =
authOAuth2 pluginName oauth2 $ \manager token -> do
oauth2GitHubScoped =
oauth2GitHubScopedWidget [whamlet|Login via #{pluginName}|]

oauth2GitHubScopedWidget
:: YesodAuth m => WidgetFor m () -> [Text] -> Text -> Text -> AuthPlugin m
oauth2GitHubScopedWidget widget scopes clientId clientSecret =
authOAuth2Widget widget pluginName oauth2 $ \manager token -> do
(User userId, userResponse) <-
authGetProfile
pluginName
Expand Down

0 comments on commit f9f7e1b

Please sign in to comment.