diff --git a/src/Yesod/Auth/OAuth2/BattleNet.hs b/src/Yesod/Auth/OAuth2/BattleNet.hs index e08b1fd..bb2d681 100644 --- a/src/Yesod/Auth/OAuth2/BattleNet.hs +++ b/src/Yesod/Auth/OAuth2/BattleNet.hs @@ -14,7 +14,6 @@ module Yesod.Auth.OAuth2.BattleNet import Yesod.Auth.OAuth2.Prelude -import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T (pack, toLower) import Yesod.Core.Widget @@ -43,10 +42,7 @@ oAuth2BattleNet clientId clientSecret region widget = pure Creds { credsPlugin = pluginName , credsIdent = T.pack $ show userId - , credsExtra = - [ ("accessToken", atoken $ accessToken token) - , ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON) - ] + , credsExtra = setExtra token userResponseJSON } where host = wwwHost $ T.toLower region diff --git a/src/Yesod/Auth/OAuth2/Bitbucket.hs b/src/Yesod/Auth/OAuth2/Bitbucket.hs index f00659f..1ad37a1 100644 --- a/src/Yesod/Auth/OAuth2/Bitbucket.hs +++ b/src/Yesod/Auth/OAuth2/Bitbucket.hs @@ -13,7 +13,6 @@ module Yesod.Auth.OAuth2.Bitbucket import Yesod.Auth.OAuth2.Prelude -import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T newtype User = User Text @@ -46,10 +45,7 @@ oauth2BitbucketScoped scopes clientId clientSecret = -- minor wart. Breaking typed APIs is one thing, causing data to go -- invalid is another. , credsIdent = T.pack $ show userId - , credsExtra = - [ ("accessToken", atoken $ accessToken token) - , ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON) - ] + , credsExtra = setExtra token userResponseJSON } where oauth2 = OAuth2 diff --git a/src/Yesod/Auth/OAuth2/EveOnline.hs b/src/Yesod/Auth/OAuth2/EveOnline.hs index 56c1bff..b954a10 100644 --- a/src/Yesod/Auth/OAuth2/EveOnline.hs +++ b/src/Yesod/Auth/OAuth2/EveOnline.hs @@ -15,7 +15,6 @@ module Yesod.Auth.OAuth2.EveOnline import Yesod.Auth.OAuth2.Prelude -import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import Yesod.Core.Widget @@ -60,10 +59,7 @@ oauth2EveScoped scopes widgetType clientId clientSecret = { credsPlugin = "eveonline" -- FIXME: Preserved bug. See similar comment in Bitbucket provider. , credsIdent = T.pack $ show userId - , credsExtra = - [ ("accessToken", atoken $ accessToken token) - , ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON) - ] + , credsExtra = setExtra token userResponseJSON } where oauth2 = OAuth2 diff --git a/src/Yesod/Auth/OAuth2/Github.hs b/src/Yesod/Auth/OAuth2/Github.hs index 4f9d775..cef48f4 100644 --- a/src/Yesod/Auth/OAuth2/Github.hs +++ b/src/Yesod/Auth/OAuth2/Github.hs @@ -5,7 +5,6 @@ -- -- * Authenticates against github -- * Uses github user id as credentials identifier --- * Returns first_name, last_name, and email as extras -- module Yesod.Auth.OAuth2.Github ( oauth2Github @@ -14,7 +13,6 @@ module Yesod.Auth.OAuth2.Github import Yesod.Auth.OAuth2.Prelude -import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T newtype User = User Int @@ -41,10 +39,7 @@ oauth2GithubScoped scopes clientId clientSecret = pure Creds { credsPlugin = pluginName , credsIdent = T.pack $ show userId - , credsExtra = - [ ("accessToken", atoken $ accessToken token) - , ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON) - ] + , credsExtra = setExtra token userResponseJSON } where oauth2 = OAuth2 diff --git a/src/Yesod/Auth/OAuth2/Google.hs b/src/Yesod/Auth/OAuth2/Google.hs index 3e20056..6e355a9 100644 --- a/src/Yesod/Auth/OAuth2/Google.hs +++ b/src/Yesod/Auth/OAuth2/Google.hs @@ -32,8 +32,6 @@ module Yesod.Auth.OAuth2.Google import Yesod.Auth.OAuth2.Prelude -import qualified Data.ByteString.Lazy as BL - newtype User = User Text instance FromJSON User where @@ -59,10 +57,7 @@ oauth2GoogleScoped scopes clientId clientSecret = pure Creds { credsPlugin = pluginName , credsIdent = userId - , credsExtra = - [ ("accessToken", atoken $ accessToken token) - , ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON) - ] + , credsExtra = setExtra token userResponseJSON } where oauth2 = OAuth2 diff --git a/src/Yesod/Auth/OAuth2/Nylas.hs b/src/Yesod/Auth/OAuth2/Nylas.hs index e250e16..38de066 100644 --- a/src/Yesod/Auth/OAuth2/Nylas.hs +++ b/src/Yesod/Auth/OAuth2/Nylas.hs @@ -7,7 +7,6 @@ module Yesod.Auth.OAuth2.Nylas import Yesod.Auth.OAuth2.Prelude import Control.Monad (unless) -import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 import Network.HTTP.Client import qualified Network.HTTP.Types as HT @@ -44,10 +43,7 @@ oauth2Nylas clientId clientSecret = (\(User userId) -> pure Creds { credsPlugin = pluginName , credsIdent = userId - , credsExtra = - [ ("accessToken", atoken $ accessToken token) - , ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON) - ] + , credsExtra = setExtra token userResponseJSON } ) $ eitherDecode userResponseJSON diff --git a/src/Yesod/Auth/OAuth2/Prelude.hs b/src/Yesod/Auth/OAuth2/Prelude.hs index 421ed2c..42dc452 100644 --- a/src/Yesod/Auth/OAuth2/Prelude.hs +++ b/src/Yesod/Auth/OAuth2/Prelude.hs @@ -13,8 +13,8 @@ module Yesod.Auth.OAuth2.Prelude -- * Helpers , authGetProfile + , setExtra , scopeParam - , maybeExtra -- * Text , Text @@ -124,6 +124,13 @@ fromAuthJSON name = -- FIXME: unique exception constructors either (throwIO . InvalidProfileResponse name . BL8.pack) pure . eitherDecode +-- | Construct (part of) @'credsExtra'@ container the token and user response +setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)] +setExtra token userResponseJSON = + [ ("accessToken", atoken $ accessToken token) + , ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON) + ] + -- | Construct an @'InvalidProfileResponse'@ exception from an @'OAuth2Error'@ -- -- This forces the @e@ in @'OAuth2Error' e@ to parse as a JSON @'Value'@ which