DRY up via setExtra

Adds some safety to the stringly-typed keys we're standardizing on.
This commit is contained in:
patrick brisbin 2018-01-27 11:31:45 -05:00
parent 79cd0161d3
commit 8cc250523b
7 changed files with 14 additions and 33 deletions

View File

@ -14,7 +14,6 @@ module Yesod.Auth.OAuth2.BattleNet
import Yesod.Auth.OAuth2.Prelude import Yesod.Auth.OAuth2.Prelude
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T (pack, toLower) import qualified Data.Text as T (pack, toLower)
import Yesod.Core.Widget import Yesod.Core.Widget
@ -43,10 +42,7 @@ oAuth2BattleNet clientId clientSecret region widget =
pure Creds pure Creds
{ credsPlugin = pluginName { credsPlugin = pluginName
, credsIdent = T.pack $ show userId , credsIdent = T.pack $ show userId
, credsExtra = , credsExtra = setExtra token userResponseJSON
[ ("accessToken", atoken $ accessToken token)
, ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON)
]
} }
where where
host = wwwHost $ T.toLower region host = wwwHost $ T.toLower region

View File

@ -13,7 +13,6 @@ module Yesod.Auth.OAuth2.Bitbucket
import Yesod.Auth.OAuth2.Prelude import Yesod.Auth.OAuth2.Prelude
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.Text as T
newtype User = User Text newtype User = User Text
@ -46,10 +45,7 @@ oauth2BitbucketScoped scopes clientId clientSecret =
-- minor wart. Breaking typed APIs is one thing, causing data to go -- minor wart. Breaking typed APIs is one thing, causing data to go
-- invalid is another. -- invalid is another.
, credsIdent = T.pack $ show userId , credsIdent = T.pack $ show userId
, credsExtra = , credsExtra = setExtra token userResponseJSON
[ ("accessToken", atoken $ accessToken token)
, ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON)
]
} }
where where
oauth2 = OAuth2 oauth2 = OAuth2

View File

@ -15,7 +15,6 @@ module Yesod.Auth.OAuth2.EveOnline
import Yesod.Auth.OAuth2.Prelude import Yesod.Auth.OAuth2.Prelude
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.Text as T
import Yesod.Core.Widget import Yesod.Core.Widget
@ -60,10 +59,7 @@ oauth2EveScoped scopes widgetType clientId clientSecret =
{ credsPlugin = "eveonline" { credsPlugin = "eveonline"
-- FIXME: Preserved bug. See similar comment in Bitbucket provider. -- FIXME: Preserved bug. See similar comment in Bitbucket provider.
, credsIdent = T.pack $ show userId , credsIdent = T.pack $ show userId
, credsExtra = , credsExtra = setExtra token userResponseJSON
[ ("accessToken", atoken $ accessToken token)
, ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON)
]
} }
where where
oauth2 = OAuth2 oauth2 = OAuth2

View File

@ -5,7 +5,6 @@
-- --
-- * Authenticates against github -- * Authenticates against github
-- * Uses github user id as credentials identifier -- * Uses github user id as credentials identifier
-- * Returns first_name, last_name, and email as extras
-- --
module Yesod.Auth.OAuth2.Github module Yesod.Auth.OAuth2.Github
( oauth2Github ( oauth2Github
@ -14,7 +13,6 @@ module Yesod.Auth.OAuth2.Github
import Yesod.Auth.OAuth2.Prelude import Yesod.Auth.OAuth2.Prelude
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.Text as T
newtype User = User Int newtype User = User Int
@ -41,10 +39,7 @@ oauth2GithubScoped scopes clientId clientSecret =
pure Creds pure Creds
{ credsPlugin = pluginName { credsPlugin = pluginName
, credsIdent = T.pack $ show userId , credsIdent = T.pack $ show userId
, credsExtra = , credsExtra = setExtra token userResponseJSON
[ ("accessToken", atoken $ accessToken token)
, ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON)
]
} }
where where
oauth2 = OAuth2 oauth2 = OAuth2

View File

@ -32,8 +32,6 @@ module Yesod.Auth.OAuth2.Google
import Yesod.Auth.OAuth2.Prelude import Yesod.Auth.OAuth2.Prelude
import qualified Data.ByteString.Lazy as BL
newtype User = User Text newtype User = User Text
instance FromJSON User where instance FromJSON User where
@ -59,10 +57,7 @@ oauth2GoogleScoped scopes clientId clientSecret =
pure Creds pure Creds
{ credsPlugin = pluginName { credsPlugin = pluginName
, credsIdent = userId , credsIdent = userId
, credsExtra = , credsExtra = setExtra token userResponseJSON
[ ("accessToken", atoken $ accessToken token)
, ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON)
]
} }
where where
oauth2 = OAuth2 oauth2 = OAuth2

View File

@ -7,7 +7,6 @@ module Yesod.Auth.OAuth2.Nylas
import Yesod.Auth.OAuth2.Prelude import Yesod.Auth.OAuth2.Prelude
import Control.Monad (unless) import Control.Monad (unless)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.ByteString.Lazy.Char8 as BL8
import Network.HTTP.Client import Network.HTTP.Client
import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types as HT
@ -44,10 +43,7 @@ oauth2Nylas clientId clientSecret =
(\(User userId) -> pure Creds (\(User userId) -> pure Creds
{ credsPlugin = pluginName { credsPlugin = pluginName
, credsIdent = userId , credsIdent = userId
, credsExtra = , credsExtra = setExtra token userResponseJSON
[ ("accessToken", atoken $ accessToken token)
, ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON)
]
} }
) )
$ eitherDecode userResponseJSON $ eitherDecode userResponseJSON

View File

@ -13,8 +13,8 @@ module Yesod.Auth.OAuth2.Prelude
-- * Helpers -- * Helpers
, authGetProfile , authGetProfile
, setExtra
, scopeParam , scopeParam
, maybeExtra
-- * Text -- * Text
, Text , Text
@ -124,6 +124,13 @@ fromAuthJSON name =
-- FIXME: unique exception constructors -- FIXME: unique exception constructors
either (throwIO . InvalidProfileResponse name . BL8.pack) pure . eitherDecode 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'@ -- | Construct an @'InvalidProfileResponse'@ exception from an @'OAuth2Error'@
-- --
-- This forces the @e@ in @'OAuth2Error' e@ to parse as a JSON @'Value'@ which -- This forces the @e@ in @'OAuth2Error' e@ to parse as a JSON @'Value'@ which