From 81ece8072f129151ee17264229c9cf85bd7304ad Mon Sep 17 00:00:00 2001
From: Florian Gilcher <florian.gilcher@asquera.de>
Date: Thu, 18 Sep 2014 11:40:12 +0200
Subject: [PATCH] Make Github name optional

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.
---
 Yesod/Auth/OAuth2/Github.hs | 19 +++++++++++--------
 1 file changed, 11 insertions(+), 8 deletions(-)

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