yesod-auth-oauth2 0.0.8 → 0.0.9

raw patch · 2 files changed

+110/−1 lines, 2 files

Files

• Yesod/Auth/OAuth2/Spotify.hs +108/−0
• yesod-auth-oauth2.cabal +2/−1

@@ -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,5 +1,5 @@ name:            yesod-auth-oauth2-version:         0.0.8+version:         0.0.9 license:         BSD3 license-file:    LICENSE author:          Tom Streller@@ -48,6 +48,7 @@                      Yesod.Auth.OAuth2.Google                      Yesod.Auth.OAuth2.Learn                      Yesod.Auth.OAuth2.Github+                     Yesod.Auth.OAuth2.Spotify      ghc-options:     -Wall