haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-09-11 03:44:57 +02:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity

Re-write Upcase

Browse Source
This commit is contained in:
patrick brisbin 2015-04-13 11:34:05 -04:00
parent 7988569b2e
commit fd08813517
No known key found for this signature in database
GPG Key ID: DB04E2CE780A17DE
1 changed files with 16 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
Yesod/Auth/OAuth2/Upcase.hs
View File

@ -14,17 +14,14 @@ module Yesod.Auth.OAuth2.Upcase
) where ) where
#if __GLASGOW_HASKELL__ < 710 #if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>), pure) import Control.Applicative ((<$>), (<*>))
#endif #endif
import Control.Exception.Lifted
import Control.Monad (mzero) import Control.Monad (mzero)
import Data.Aeson import Data.Aeson
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.OAuth2 import Yesod.Auth.OAuth2
import Network.HTTP.Conduit(Manager)
import qualified Data.Text as T import qualified Data.Text as T
data UpcaseUser = UpcaseUser data UpcaseUser = UpcaseUser
@ -55,31 +52,19 @@ oauth2Upcase :: YesodAuth m
=> Text -- ^ Client ID => Text -- ^ Client ID
-> Text -- ^ Client Secret -> Text -- ^ Client Secret
-> AuthPlugin m -> AuthPlugin m
oauth2Upcase clientId clientSecret = authOAuth2 "upcase" oauth2Upcase = oauth2Plugin OAuth2Plugin
OAuth2 { oapName = "upcase"
{ oauthClientId = encodeUtf8 clientId , oapAuthEndpoint = "http://upcase.com/oauth/authorize"
, oauthClientSecret = encodeUtf8 clientSecret , oapTokenEndpoint = "http://upcase.com/oauth/token"
, oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize" , oapFetchProfile = \manager token ->
, oauthAccessTokenEndpoint = "http://upcase.com/oauth/token" authGetJSON manager token "http://upcase.com/api/v1/me.json"
, oauthCallback = Nothing , oapToCredsIdent = T.pack . show . upcaseUserId
} , oapToCredsExtra = toCredsExtra
fetchUpcaseProfile
fetchUpcaseProfile :: Manager -> AccessToken -> IO (Creds m)
fetchUpcaseProfile manager token = do
result <- authGetJSON manager token "http://upcase.com/api/v1/me.json"
case result of
Right (UpcaseResponse user) -> return $ toCreds user
Left err -> throwIO $ InvalidProfileResponse "upcase" err
toCreds :: UpcaseUser -> Creds m
toCreds user = Creds
{ credsPlugin = "upcase"
, credsIdent = T.pack $ show $ upcaseUserId user
, credsExtra =
[ ("first_name", upcaseUserFirstName user)
, ("last_name" , upcaseUserLastName user)
, ("email" , upcaseUserEmail user)
]
} }
toCredsExtra :: UpcaseUser -> [(Text, Text)]
toCredsExtra user =
[ ("first_name", upcaseUserFirstName user)
, ("last_name" , upcaseUserLastName user)
, ("email" , upcaseUserEmail user)
]