mirror of
https://github.com/freckle/yesod-auth-oauth2.git
synced 2026-09-19 23:44:57 +02:00
Use consistent style throughout project
- Alphabetize imports - Place qualified imports separate and last - BL for ByteString.Lazy - Don't align tokens in tuple lists or record assignments - Two-space indent for where keyword - Use record syntax for Creds - Break before operators in Applicative expressions - Consistent whitespace throughout Resolves #19
This commit is contained in:
parent
029122f662
commit
0b0e6c179d
@ -23,17 +23,17 @@ import Data.Text (Text, pack)
|
||||
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import Data.Typeable
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Network.OAuth.OAuth2
|
||||
import Network.HTTP.Conduit(Manager)
|
||||
import System.Random
|
||||
import Yesod.Auth
|
||||
import Yesod.Core
|
||||
import Yesod.Form
|
||||
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
|
||||
-- | Provider name and Aeson parse error
|
||||
data YesodOAuth2Exception = InvalidProfileResponse Text BSL.ByteString
|
||||
data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
|
||||
deriving (Show, Typeable)
|
||||
|
||||
instance Exception YesodOAuth2Exception
|
||||
|
||||
@ -17,12 +17,13 @@ import Control.Applicative ((<$>), (<*>))
|
||||
import Control.Exception.Lifted
|
||||
import Control.Monad (mzero)
|
||||
import Data.Aeson
|
||||
import Data.Text (Text)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2
|
||||
import Network.HTTP.Conduit(Manager)
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
data GithubUser = GithubUser
|
||||
@ -33,8 +34,8 @@ data GithubUser = GithubUser
|
||||
}
|
||||
|
||||
instance FromJSON GithubUser where
|
||||
parseJSON (Object o) =
|
||||
GithubUser <$> o .: "id"
|
||||
parseJSON (Object o) = GithubUser
|
||||
<$> o .: "id"
|
||||
<*> o .:? "name"
|
||||
<*> o .: "login"
|
||||
<*> o .: "avatar_url"
|
||||
@ -46,8 +47,8 @@ data GithubUserEmail = GithubUserEmail
|
||||
}
|
||||
|
||||
instance FromJSON GithubUserEmail where
|
||||
parseJSON (Object o) =
|
||||
GithubUserEmail <$> o .: "email"
|
||||
parseJSON (Object o) = GithubUserEmail
|
||||
<$> o .: "email"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
@ -84,14 +85,17 @@ fetchGithubProfile manager token = do
|
||||
(_, Left err) -> throwIO $ InvalidProfileResponse "github" err
|
||||
|
||||
toCreds :: GithubUser -> [GithubUserEmail] -> AccessToken -> Creds m
|
||||
toCreds user userMail token = Creds "github"
|
||||
(T.pack $ show $ githubUserId user)
|
||||
cExtra
|
||||
where
|
||||
cExtra = [ ("email", githubUserEmail $ head userMail)
|
||||
toCreds user userMail token = Creds
|
||||
{ credsPlugin = "github"
|
||||
, credsIdent = T.pack $ show $ githubUserId user
|
||||
, credsExtra =
|
||||
[ ("email", githubUserEmail $ head userMail)
|
||||
, ("login", githubUserLogin user)
|
||||
, ("avatar_url", githubUserAvatarUrl user)
|
||||
, ("access_token", decodeUtf8 $ accessToken token)
|
||||
] ++ (maybeName $ githubUserName user)
|
||||
] ++ maybeName (githubUserName user)
|
||||
}
|
||||
|
||||
where
|
||||
maybeName Nothing = []
|
||||
maybeName (Just name) = [("name", name)]
|
||||
|
||||
@ -1,5 +1,8 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://spotify.com
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Spotify
|
||||
( oauth2Spotify
|
||||
, module Yesod.Auth.OAuth2
|
||||
@ -16,6 +19,7 @@ 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
|
||||
|
||||
@ -26,10 +30,10 @@ data SpotifyUserImage = SpotifyUserImage
|
||||
}
|
||||
|
||||
instance FromJSON SpotifyUserImage where
|
||||
parseJSON (Object v) = SpotifyUserImage <$>
|
||||
v .: "height" <*>
|
||||
v .: "width" <*>
|
||||
v .: "url"
|
||||
parseJSON (Object v) = SpotifyUserImage
|
||||
<$> v .: "height"
|
||||
<*> v .: "width"
|
||||
<*> v .: "url"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
@ -45,15 +49,16 @@ data SpotifyUser = SpotifyUser
|
||||
}
|
||||
|
||||
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 (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
|
||||
@ -62,13 +67,13 @@ oauth2Spotify :: YesodAuth m
|
||||
-> [ByteString] -- ^ Scopes
|
||||
-> AuthPlugin m
|
||||
oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify"
|
||||
(OAuth2
|
||||
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)
|
||||
@ -79,9 +84,11 @@ fetchSpotifyProfile manager token = do
|
||||
Left err -> throwIO $ InvalidProfileResponse "spotify" err
|
||||
|
||||
toCreds :: SpotifyUser -> Creds m
|
||||
toCreds user = Creds "spotify"
|
||||
(spotifyUserId user)
|
||||
(mapMaybe getExtra extrasTemplate)
|
||||
toCreds user = Creds
|
||||
{ credsPlugin = "spotify"
|
||||
, credsIdent = spotifyUserId user
|
||||
, credsExtra = mapMaybe getExtra extrasTemplate
|
||||
}
|
||||
|
||||
where
|
||||
userImage :: Maybe SpotifyUserImage
|
||||
@ -90,18 +97,15 @@ toCreds user = Creds "spotify"
|
||||
userImagePart :: (SpotifyUserImage -> Maybe a) -> Maybe a
|
||||
userImagePart getter = userImage >>= getter
|
||||
|
||||
extrasTemplate = [ ("href" , Just $ spotifyUserHref user)
|
||||
, ("uri" , Just $ spotifyUserUri user)
|
||||
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)
|
||||
, ("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)
|
||||
|
||||
@ -31,8 +31,8 @@ data UpcaseUser = UpcaseUser
|
||||
}
|
||||
|
||||
instance FromJSON UpcaseUser where
|
||||
parseJSON (Object o) =
|
||||
UpcaseUser <$> o .: "id"
|
||||
parseJSON (Object o) = UpcaseUser
|
||||
<$> o .: "id"
|
||||
<*> o .: "first_name"
|
||||
<*> o .: "last_name"
|
||||
<*> o .: "email"
|
||||
@ -42,8 +42,8 @@ instance FromJSON UpcaseUser where
|
||||
data UpcaseResponse = UpcaseResponse UpcaseUser
|
||||
|
||||
instance FromJSON UpcaseResponse where
|
||||
parseJSON (Object o) =
|
||||
UpcaseResponse <$> o .: "user"
|
||||
parseJSON (Object o) = UpcaseResponse
|
||||
<$> o .: "user"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
@ -70,9 +70,12 @@ fetchUpcaseProfile manager token = do
|
||||
Left err -> throwIO $ InvalidProfileResponse "upcase" err
|
||||
|
||||
toCreds :: UpcaseUser -> Creds m
|
||||
toCreds user = Creds "upcase"
|
||||
(T.pack $ show $ upcaseUserId user)
|
||||
toCreds user = Creds
|
||||
{ credsPlugin = "upcase"
|
||||
, credsIdent = T.pack $ show $ upcaseUserId user
|
||||
, credsExtra =
|
||||
[ ("first_name", upcaseUserFirstName user)
|
||||
, ("last_name" , upcaseUserLastName user)
|
||||
, ("email" , upcaseUserEmail user)
|
||||
]
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user