Skip to content

Commit

Permalink
Merge pull request #13 from benekastah/master
Browse files Browse the repository at this point in the history
Add Yesod.Auth.OAuth2.Spotify
  • Loading branch information
pbrisbin committed Sep 22, 2014
2 parents 46b0d1f + 261cbc3 commit a4623d9
Show file tree
Hide file tree
Showing 3 changed files with 112 additions and 0 deletions.
3 changes: 3 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
*.swp
dist/
cabal-dev/
.cabal-sandbox
cabal.sandbox.config
tags
108 changes: 108 additions & 0 deletions Yesod/Auth/OAuth2/Spotify.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,108 @@
{-# LANGUAGE OverloadedStrings #-}

module Yesod.Auth.OAuth2.Spotify
( oauth2Spotify
, module Yesod.Auth.OAuth2
) where

import Control.Applicative ((<$>), (<*>))
import Control.Exception.Lifted
import Control.Monad (mzero)
import Data.Aeson
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
, 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 -- ^ Client ID
-> Text -- ^ Client Secret
-> [ByteString] -- ^ Scopes
-> AuthPlugin m
oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify"
(OAuth2
{ oauthClientId = encodeUtf8 clientId
, oauthClientSecret = encodeUtf8 clientSecret
, oauthOAuthorizeEndpoint = B.append "https://accounts.spotify.com/authorize?scope=" (B.intercalate "%20" scope)
, oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token"
, oauthCallback = Nothing
})
fetchSpotifyProfile

fetchSpotifyProfile :: Manager -> AccessToken -> IO (Creds m)
fetchSpotifyProfile manager token = do
result <- authGetJSON manager token "https://api.spotify.com/v1/me"
case result of
Right user -> return $ toCreds user
Left err -> throwIO $ InvalidProfileResponse "spotify" err

toCreds :: SpotifyUser -> Creds m
toCreds user = Creds "spotify"
(spotifyUserId 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
1 change: 1 addition & 0 deletions yesod-auth-oauth2.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@ library
Yesod.Auth.OAuth2.Google
Yesod.Auth.OAuth2.Learn
Yesod.Auth.OAuth2.Github
Yesod.Auth.OAuth2.Spotify

ghc-options: -Wall

Expand Down

0 comments on commit a4623d9

Please sign in to comment.