From 261cbc30aac415b7ed6761558298dbd44c2295fb Mon Sep 17 00:00:00 2001
From: Paul Harper <paul@chartio.com>
Date: Sun, 21 Sep 2014 23:42:13 -0700
Subject: [PATCH] Scopes can now be passed in, most of the spotify user object
 is returned in the credentials

---
 Yesod/Auth/OAuth2/Spotify.hs | 69 ++++++++++++++++++++++++++++++------
 1 file changed, 58 insertions(+), 11 deletions(-)

diff --git a/Yesod/Auth/OAuth2/Spotify.hs b/Yesod/Auth/OAuth2/Spotify.hs
index 107c740..600f015 100644
--- a/Yesod/Auth/OAuth2/Spotify.hs
+++ b/Yesod/Auth/OAuth2/Spotify.hs
@@ -9,37 +9,63 @@ import Control.Applicative ((<$>), (<*>))
 import Control.Exception.Lifted
 import Control.Monad (mzero)
 import Data.Aeson
-import Data.Text (Text)
 import Data.ByteString (ByteString)
+import Data.Maybe
+import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Network.HTTP.Conduit(Manager)
 import Yesod.Auth
 import Yesod.Auth.OAuth2
+import qualified Data.ByteString as B
+import qualified Data.Text as T
+
+data SpotifyUserImage = SpotifyUserImage
+    { spotifyUserImageHeight :: Maybe Int
+    , spotifyUserImageWidth :: Maybe Int
+    , spotifyUserImageUrl :: Text
+    }
+
+instance FromJSON SpotifyUserImage where
+    parseJSON (Object v) = SpotifyUserImage <$>
+                           v .: "height" <*>
+                           v .: "width" <*>
+                           v .: "url"
+
+    parseJSON _ = mzero
 
 data SpotifyUser = SpotifyUser
     { spotifyUserId          :: Text
     , spotifyUserHref        :: Text
-    , spotifyUserDisplayName :: Text
-    , spotifyProduct         :: Text
+    , spotifyUserUri         :: Text
+    , spotifyUserDisplayName :: Maybe Text
+    , spotifyUserProduct     :: Maybe Text
+    , spotifyUserCountry     :: Maybe Text
+    , spotifyUserEmail       :: Maybe Text
+    , spotifyUserImages      :: Maybe [SpotifyUserImage]
     }
 
 instance FromJSON SpotifyUser where
     parseJSON (Object v) = SpotifyUser <$>
                            v .: "id" <*>
                            v .: "href" <*>
-                           v .: "display_name" <*>
-                           v .: "product"
+                           v .: "uri" <*>
+                           v .:? "display_name" <*>
+                           v .:? "product" <*>
+                           v .:? "country" <*>
+                           v .:? "email" <*>
+                           v .:? "images"
     parseJSON _ = mzero
 
 oauth2Spotify :: YesodAuth m
              => Text -- ^ Client ID
              -> Text -- ^ Client Secret
+             -> [ByteString] -- ^ Scopes
              -> AuthPlugin m
-oauth2Spotify clientId clientSecret = authOAuth2 "spotify"
+oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify"
     (OAuth2
         { oauthClientId            = encodeUtf8 clientId
         , oauthClientSecret        = encodeUtf8 clientSecret
-        , oauthOAuthorizeEndpoint  = "https://accounts.spotify.com/authorize"
+        , oauthOAuthorizeEndpoint  = B.append "https://accounts.spotify.com/authorize?scope=" (B.intercalate "%20" scope)
         , oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token"
         , oauthCallback            = Nothing
         })
@@ -55,7 +81,28 @@ fetchSpotifyProfile manager token = do
 toCreds :: SpotifyUser -> Creds m
 toCreds user = Creds "spotify"
     (spotifyUserId user)
-    [ ("href"        , spotifyUserHref user)
-    , ("display_name", spotifyUserDisplayName user)
-    , ("product"     , spotifyProduct user)
-    ]
+    (mapMaybe getExtra extrasTemplate)
+
+  where
+    userImage :: Maybe SpotifyUserImage
+    userImage = spotifyUserImages user >>= listToMaybe
+
+    userImagePart :: (SpotifyUserImage -> Maybe a) -> Maybe a
+    userImagePart getter = userImage >>= getter
+
+    extrasTemplate = [ ("href"        , Just $ spotifyUserHref user)
+                     , ("uri"         , Just $ spotifyUserUri user)
+                     , ("display_name", spotifyUserDisplayName user)
+                     , ("product"     , spotifyUserProduct user)
+                     , ("country"     , spotifyUserCountry user)
+                     , ("email"       , spotifyUserEmail user)
+                     , ("image_url"   , userImage >>=
+                                        return . spotifyUserImageUrl)
+                     , ("image_height", userImagePart spotifyUserImageHeight >>=
+                                        return . T.pack . show)
+                     , ("image_width" , userImagePart spotifyUserImageWidth >>=
+                                        return . T.pack . show)
+                     ]
+
+    getExtra :: (Text, Maybe Text) -> Maybe (Text, Text)
+    getExtra (key, val) = fmap ((,) key) val