Experimental extra credentials fix. Also adds .:? combinator in Spotify.hs

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

@@ -106,19 +106,10 @@ toCreds user userMails token = Creds
         , ("avatar_url", githubUserAvatarUrl user)
         , ("access_token", decodeUtf8 $ accessToken token)
         ]
-        ++ maybeName (githubUserName user)
+        ++ maybeExtra "name" (githubUserName user)
-        ++ maybePublicEmail (githubUserPublicEmail user)
+        ++ maybeExtra "email" (githubUserPublicEmail user)
-        ++ maybeLocation (githubUserLocation 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)]
-
-    maybeLocation Nothing = []
-    maybeLocation (Just location) = [("location", location)]

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