Properly handle empty credsExtra fields

Marks "location" as Maybe in GitHub responses. Without this, users could
experience an InvalidProfileResponse error when missing.

Also fixes cases where fields were Maybe, but the (.:?) combinator was
not being used in the parser.

Yesod/Auth/OAuth2.hs

@@ -15,6 +15,7 @@ module Yesod.Auth.OAuth2
     , oauth2Url
     , fromProfileURL
     , YesodOAuth2Exception(..)
+    , maybeExtra
     , module Network.OAuth.OAuth2
     ) where
 
@@ -149,3 +150,9 @@ appendQuery url query =
     if '?' `C8.elem` url
         then url <> "&" <> query
         else url <> "?" <> query
+
+-- | A helper for providing an optional value to credsExtra
+--
+maybeExtra :: Text -> Maybe Text -> [(Text, Text)]
+maybeExtra k (Just v) = [(k, v)]
+maybeExtra _ Nothing  = []

Yesod/Auth/OAuth2/Github.hs

@@ -37,7 +37,7 @@ data GithubUser = GithubUser
     , githubUserName :: Maybe Text
     , githubUserLogin :: Text
     , githubUserAvatarUrl :: Text
-    , githubUserLocation :: Text
+    , githubUserLocation :: Maybe Text
     , githubUserPublicEmail :: Maybe Text
     }
 
@@ -47,8 +47,8 @@ instance FromJSON GithubUser where
         <*> o .:? "name"
         <*> o .: "login"
         <*> o .: "avatar_url"
-        <*> o .: "location"
+        <*> o .:? "location"
-        <*> o .: "email"
+        <*> o .:? "email"
 
     parseJSON _ = mzero
 
@@ -104,18 +104,12 @@ toCreds user userMails token = Creds
         [ ("email", githubUserEmailAddress email)
         , ("login", githubUserLogin user)
         , ("avatar_url", githubUserAvatarUrl user)
-        , ("location", githubUserLocation user)
         , ("access_token", decodeUtf8 $ accessToken token)
         ]
-        ++ maybeName (githubUserName user)
+        ++ maybeExtra "name" (githubUserName user)
-        ++ maybePublicEmail (githubUserPublicEmail user)
+        ++ maybeExtra "email" (githubUserPublicEmail user)
+        ++ maybeExtra "location" (githubUserLocation user)
     }
 
   where
     email = fromMaybe (head userMails) $ find githubUserEmailPrimary userMails
-
-    maybeName Nothing = []
-    maybeName (Just name) = [("name", name)]
-
-    maybePublicEmail Nothing = []
-    maybePublicEmail (Just e) = [("public_email", e)]

Yesod/Auth/OAuth2/Google.hs

@@ -29,7 +29,6 @@ import Control.Exception.Lifted
 import Control.Monad (mzero)
 import Data.Aeson
 import Data.Monoid ((<>))
-import Data.Maybe (maybeToList)
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import Network.HTTP.Conduit (Manager)
@@ -135,8 +134,6 @@ uidBuilder f user token = Creds
         , ("family_name", googleUserFamilyName user)
         , ("avatar_url", googleUserPicture user)
         , ("access_token", decodeUtf8 $ accessToken token)
-        ] ++ maybeHostedDomain
+        ]
+        ++ maybeExtra "hosted_domain" (googleUserHostedDomain user)
     }
-
-  where
-    maybeHostedDomain = maybeToList $ (,) "hosted_domain" <$> googleUserHostedDomain user

Yesod/Auth/OAuth2/Spotify.hs

@@ -33,8 +33,8 @@ data SpotifyUserImage = SpotifyUserImage
 
 instance FromJSON SpotifyUserImage where
     parseJSON (Object v) = SpotifyUserImage
-        <$> v .: "height"
+        <$> v .:? "height"
-        <*> v .: "width"
+        <*> v .:? "width"
         <*> v .: "url"
 
     parseJSON _ = mzero