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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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