haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-01-11 19:58:28 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Set the ByteString body at userResponse

Browse Source 
- It may not be JSON (thought it always is now)
- The JSON suffix should be used only when it is (such as in
  getUserResponseJSON)
This commit is contained in:
patrick brisbin 2018-01-28 08:20:48 -05:00
parent fccd7a1d66
commit a2a49a2c57
13 changed files with 42 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
README.md
View File

@ -42,7 +42,7 @@ authenticate creds = do
let
-- You can run your own FromJSON parser on the respose we already have
eGitHubUser :: Either String GitHubUser
eGitHubUser = getUserResponse creds
eGitHubUser = getUserResponseJSON creds
-- Avert your eyes
Right githubUser = eGitHubUser
@ -76,9 +76,9 @@ oauth2MySite :: YesodAuth m => Text -> Text -> AuthPlugin m
oauth2MySite clientId clientSecret =
authOAuth2 pluginName oauth2 $ \manager token -> do
-- Fetch a profile using the manager and token, leave it a ByteString
userResponseJSON <- -- ...
userResponse <- -- ...
-- Parse it to your preferred identifier, see Data.Aeson
-- Parse it to your preferred identifier, e.g. with Data.Aeson
userId <- -- ...
-- See authGetProfile for the typical case
@ -86,7 +86,7 @@ oauth2MySite clientId clientSecret =
pure Creds
{ credsPlugin = pluginName
, credsIdent = userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
oauth2 = OAuth2

16
src/Yesod/Auth/OAuth2.hs
View File

@ -19,8 +19,8 @@ module Yesod.Auth.OAuth2
-- * Reading our @'credsExtra'@ keys
, getAccessToken
, getUserResponseJSON
, getUserResponse
, getUserResponseJSON
) where
import Data.Aeson (FromJSON, eitherDecode)
@ -74,15 +74,15 @@ getAccessToken = AccessToken
--
-- This is unsafe.
--
getUserResponseJSON :: Creds m -> ByteString
getUserResponseJSON = fromStrict . encodeUtf8
. fromJustNote "yesod-auth-oauth2 bug: credsExtra without userResponseJSON"
. lookup "userResponseJSON" . credsExtra
getUserResponse :: Creds m -> ByteString
getUserResponse = fromStrict . encodeUtf8
. fromJustNote "yesod-auth-oauth2 bug: credsExtra without userResponse"
. lookup "userResponse" . credsExtra
-- | Read from the values set via @'setExtra'@
-- | Read from the values set via @'setExtra'@, decode as JSON
--
-- This is unsafe if the key is missing, but safe with respect to parsing
-- errors.
--
getUserResponse :: FromJSON a => Creds m -> Either String a
getUserResponse = eitherDecode . getUserResponseJSON
getUserResponseJSON :: FromJSON a => Creds m -> Either String a
getUserResponseJSON = eitherDecode . getUserResponse

4
src/Yesod/Auth/OAuth2/BattleNet.hs
View File

@ -35,14 +35,14 @@ oAuth2BattleNet
-> AuthPlugin m
oAuth2BattleNet clientId clientSecret region widget =
authOAuth2Widget widget pluginName oauth2 $ \manager token -> do
(User userId, userResponseJSON) <-
(User userId, userResponse) <-
authGetProfile pluginName manager token
$ fromRelative "https" (apiHost $ T.toLower region) "/account/user"
pure Creds
{ credsPlugin = pluginName
, credsIdent = T.pack $ show userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
host = wwwHost $ T.toLower region

4
src/Yesod/Auth/OAuth2/Bitbucket.hs
View File

@ -33,7 +33,7 @@ oauth2Bitbucket = oauth2BitbucketScoped defaultScopes
oauth2BitbucketScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
oauth2BitbucketScoped scopes clientId clientSecret =
authOAuth2 pluginName oauth2 $ \manager token -> do
(User userId, userResponseJSON) <-
(User userId, userResponse) <-
authGetProfile pluginName manager token "https://api.bitbucket.com/2.0/user"
pure Creds
@ -45,7 +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 = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
oauth2 = OAuth2

4
src/Yesod/Auth/OAuth2/EveOnline.hs
View File

@ -52,14 +52,14 @@ oauth2Eve = oauth2EveScoped defaultScopes
oauth2EveScoped :: YesodAuth m => [Text] -> WidgetType m -> Text -> Text -> AuthPlugin m
oauth2EveScoped scopes widgetType clientId clientSecret =
authOAuth2Widget (asWidget widgetType) pluginName oauth2 $ \manager token -> do
(User userId, userResponseJSON) <-
(User userId, userResponse) <-
authGetProfile pluginName manager token "https://login.eveonline.com/oauth/verify"
pure Creds
{ credsPlugin = "eveonline"
-- FIXME: Preserved bug. See similar comment in Bitbucket provider.
, credsIdent = T.pack $ show userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
oauth2 = OAuth2

4
src/Yesod/Auth/OAuth2/Github.hs
View File

@ -33,13 +33,13 @@ oauth2Github = oauth2GithubScoped defaultScopes
oauth2GithubScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
oauth2GithubScoped scopes clientId clientSecret =
authOAuth2 pluginName oauth2 $ \manager token -> do
(User userId, userResponseJSON) <-
(User userId, userResponse) <-
authGetProfile pluginName manager token "https://api.github.com/user"
pure Creds
{ credsPlugin = pluginName
, credsIdent = T.pack $ show userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
oauth2 = OAuth2

10
src/Yesod/Auth/OAuth2/Google.hs
View File

@ -8,7 +8,7 @@
--
-- If you were previously relying on email as the creds identifier, you can
-- still do that (and more) by overriding it in the creds returned by the plugin
-- with any value read out of the new @userResponseJSON@ key in @'credsExtra'@.
-- with any value read out of the new @userResponse@ key in @'credsExtra'@.
--
-- For example:
--
@ -17,8 +17,8 @@
-- > instance FromJSON User where -- you know...
-- >
-- > authenticate creds = do
-- > -- 'getUserResponse' provided by "Yesod.Auth.OAuth" module
-- > let Right email = userEmail <$> getUserResponse creds
-- > -- 'getUserResponseJSON' provided by "Yesod.Auth.OAuth" module
-- > let Right email = userEmail <$> getUserResponseJSON creds
-- > updatedCreds = creds { credsIdent = email }
-- >
-- > -- continue normally with updatedCreds
@ -49,13 +49,13 @@ oauth2Google = oauth2GoogleScoped defaultScopes
oauth2GoogleScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
oauth2GoogleScoped scopes clientId clientSecret =
authOAuth2 pluginName oauth2 $ \manager token -> do
(User userId, userResponseJSON) <-
(User userId, userResponse) <-
authGetProfile pluginName manager token "https://www.googleapis.com/oauth2/v3/userinfo"
pure Creds
{ credsPlugin = pluginName
, credsIdent = userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
oauth2 = OAuth2

8
src/Yesod/Auth/OAuth2/Nylas.hs
View File

@ -29,13 +29,13 @@ oauth2Nylas clientId clientSecret =
req <- applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) ""
<$> parseRequest "https://api.nylas.com/account"
resp <- httpLbs req manager
let userResponseJSON = responseBody resp
let userResponse = responseBody resp
-- FIXME: was this working? I'm 95% sure that the client will throw its
-- own exception on unsuccessful status codes.
unless (HT.statusIsSuccessful $ responseStatus resp)
$ throwIO $ InvalidProfileResponse pluginName
$ "Unsuccessful HTTP response: " <> userResponseJSON
$ "Unsuccessful HTTP response: " <> userResponse
either
@ -43,10 +43,10 @@ oauth2Nylas clientId clientSecret =
(\(User userId) -> pure Creds
{ credsPlugin = pluginName
, credsIdent = userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
)
$ eitherDecode userResponseJSON
$ eitherDecode userResponse
where
oauth = OAuth2
{ oauthClientId = clientId

6
src/Yesod/Auth/OAuth2/Prelude.hs
View File

@ -117,10 +117,10 @@ scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d
-- Sets the following keys:
--
-- - @accessToken@: to support follow-up requests
-- - @userResponseJSON@: to support getting additional information
-- - @userResponse@: to support getting additional information
--
setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)]
setExtra token userResponseJSON =
setExtra token userResponse =
[ ("accessToken", atoken $ accessToken token)
, ("userResponseJSON", decodeUtf8 $ BL.toStrict userResponseJSON)
, ("userResponse", decodeUtf8 $ BL.toStrict userResponse)
]

4
src/Yesod/Auth/OAuth2/Salesforce.hs
View File

@ -57,12 +57,12 @@ salesforceHelper
-> AuthPlugin m
salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSecret =
authOAuth2 name oauth2 $ \manager token -> do
(User userId, userResponseJSON) <- authGetProfile name manager token profileUri
(User userId, userResponse) <- authGetProfile name manager token profileUri
pure Creds
{ credsPlugin = pluginName
, credsIdent = userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
oauth2 = OAuth2

8
src/Yesod/Auth/OAuth2/Slack.hs
View File

@ -50,17 +50,17 @@ oauth2SlackScoped scopes clientId clientSecret =
let param = encodeUtf8 $ atoken $ accessToken token
req <- setQueryString [("token", Just param)]
<$> parseUrlThrow "https://slack.com/api/users.identity"
userResponseJSON <- responseBody <$> httpLbs req manager
userResponse <- responseBody <$> httpLbs req manager
either
(const $ throwIO $ InvalidProfileResponse pluginName userResponseJSON)
(const $ throwIO $ InvalidProfileResponse pluginName userResponse)
(\(User userId) -> pure Creds
{ credsPlugin = pluginName
, credsIdent = userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
)
$ eitherDecode userResponseJSON
$ eitherDecode userResponse
where
oauth2 = OAuth2
{ oauthClientId = clientId

4
src/Yesod/Auth/OAuth2/Spotify.hs
View File

@ -21,13 +21,13 @@ pluginName = "spotify"
oauth2Spotify :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
oauth2Spotify scopes clientId clientSecret =
authOAuth2 pluginName oauth2 $ \manager token -> do
(User userId, userResponseJSON) <-
(User userId, userResponse) <-
authGetProfile pluginName manager token "https://api.spotify.com/v1/me"
pure Creds
{ credsPlugin = pluginName
, credsIdent = userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
oauth2 = OAuth2

4
src/Yesod/Auth/OAuth2/Upcase.hs
View File

@ -27,13 +27,13 @@ pluginName = "upcase"
oauth2Upcase :: YesodAuth m => Text -> Text -> AuthPlugin m
oauth2Upcase clientId clientSecret =
authOAuth2 pluginName oauth2 $ \manager token -> do
(User userId, userResponseJSON) <-
(User userId, userResponse) <-
authGetProfile pluginName manager token "http://upcase.com/api/v1/me.json"
pure Creds
{ credsPlugin = pluginName
, credsIdent = T.pack $ show userId
, credsExtra = setExtra token userResponseJSON
, credsExtra = setExtra token userResponse
}
where
oauth2 = OAuth2