haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-09-03 16:33:49 +02:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Make Github name optional

Browse Source 
The github API returns no name field if the user has given none (and
only goes by their user handle). For that reason, make the name field
optional.
This commit is contained in:
Florian Gilcher 2014-09-18 11:40:12 +02:00
parent d2e384c1aa
commit 81ece8072f
1 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Yesod/Auth/OAuth2/Github.hs
View File

@ -32,7 +32,7 @@ import qualified Data.Text as T
data GithubUser = GithubUser data GithubUser = GithubUser
{ githubUserId :: Int { githubUserId :: Int
, githubUserName :: Text , githubUserName :: Maybe Text
, githubUserLogin :: Text , githubUserLogin :: Text
, githubUserAvatarUrl :: Text , githubUserAvatarUrl :: Text
} }
@ -40,7 +40,7 @@ data GithubUser = GithubUser
instance FromJSON GithubUser where instance FromJSON GithubUser where
parseJSON (Object o) = parseJSON (Object o) =
GithubUser <$> o .: "id" GithubUser <$> o .: "id"
<*> o .: "name" <*> o .:? "name"
<*> o .: "login" <*> o .: "login"
<*> o .: "avatar_url" <*> o .: "avatar_url"
@ -113,9 +113,12 @@ fetchGithubProfile manager token = do
toCreds :: GithubUser -> [GithubUserEmail] -> AccessToken -> Creds m toCreds :: GithubUser -> [GithubUserEmail] -> AccessToken -> Creds m
toCreds user userMail token = Creds "github" toCreds user userMail token = Creds "github"
(T.pack $ show $ githubUserId user) (T.pack $ show $ githubUserId user)
[ ("name", githubUserName user) cExtra
, ("email", githubUserEmail $ head userMail) where
, ("login", githubUserLogin user) cExtra = [ ("email", githubUserEmail $ head userMail)
, ("avatar_url", githubUserAvatarUrl user) , ("login", githubUserLogin user)
, ("access_token", decodeUtf8 $ accessToken token) , ("avatar_url", githubUserAvatarUrl user)
] , ("access_token", decodeUtf8 $ accessToken token)
] ++ (maybeName $ githubUserName user)
maybeName Nothing = []
maybeName (Just name) = [("name", name)]