yesod-auth-oauth2/Yesod/Auth/OAuth2/Spotify.hs
patrick brisbin 46f6a9118d
Refactor Spotify
- Scopes argument is now in first position
- Scopes list is given as Text values
2015-04-13 11:46:43 -04:00

102 lines
3.1 KiB
Haskell

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
--
-- OAuth2 plugin for http://spotify.com
--
module Yesod.Auth.OAuth2.Spotify
( oauth2Spotify
, module Yesod.Auth.OAuth2
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Monad (mzero)
import Data.Aeson
import Data.Maybe
import Data.Monoid ((<>))
import Data.Text (Text)
import Yesod.Auth
import Yesod.Auth.OAuth2
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
, 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 .: "uri"
<*> v .:? "display_name"
<*> v .:? "product"
<*> v .:? "country"
<*> v .:? "email"
<*> v .:? "images"
parseJSON _ = mzero
oauth2Spotify :: YesodAuth m
=> [Text] -- ^ Scopes
-> Text -- ^ Client ID
-> Text -- ^ Client Secret
-> AuthPlugin m
oauth2Spotify scopes = oauth2Plugin OAuth2Plugin
{ oapName = "spotify"
, oapAuthEndpoint = "https://accounts.spotify.com/authorize?scope=" <> T.intercalate "%20" scopes
, oapTokenEndpoint = "https://accounts.spotify.com/api/token"
, oapFetchProfile = \manager token ->
authGetJSON manager token "https://api.spotify.com/v1/me"
, oapToCredsIdent = spotifyUserId
, oapToCredsExtra = toCredsExtra
}
toCredsExtra :: SpotifyUser -> [(Text, Text)]
toCredsExtra 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", spotifyUserImageUrl <$> userImage)
, ("image_height", T.pack . show <$> userImagePart spotifyUserImageHeight)
, ("image_width", T.pack . show <$> userImagePart spotifyUserImageWidth)
]
getExtra :: (Text, Maybe Text) -> Maybe (Text, Text)
getExtra (key, val) = fmap ((,) key) val