From 029122f662034d4429314769afed08d858f2b432 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 24 Mar 2015 17:56:59 -0400 Subject: [PATCH] Learn rebranded as Upcase --- Yesod/Auth/OAuth2.hs | 2 +- Yesod/Auth/OAuth2/Learn.hs | 78 ------------------------------------- Yesod/Auth/OAuth2/Upcase.hs | 78 +++++++++++++++++++++++++++++++++++++ yesod-auth-oauth2.cabal | 2 +- 4 files changed, 80 insertions(+), 80 deletions(-) delete mode 100644 Yesod/Auth/OAuth2/Learn.hs create mode 100644 Yesod/Auth/OAuth2/Upcase.hs diff --git a/Yesod/Auth/OAuth2.hs b/Yesod/Auth/OAuth2.hs index 849eeee..c7e01ce 100644 --- a/Yesod/Auth/OAuth2.hs +++ b/Yesod/Auth/OAuth2.hs @@ -5,7 +5,7 @@ -- -- Generic OAuth2 plugin for Yesod -- --- * See Yesod.Auth.OAuth2.Learn for example usage. +-- * See Yesod.Auth.OAuth2.GitHub for example usage. -- module Yesod.Auth.OAuth2 ( authOAuth2 diff --git a/Yesod/Auth/OAuth2/Learn.hs b/Yesod/Auth/OAuth2/Learn.hs deleted file mode 100644 index d260664..0000000 --- a/Yesod/Auth/OAuth2/Learn.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | --- --- OAuth2 plugin for http://learn.thoughtbot.com --- --- * Authenticates against learn --- * Uses learn user id as credentials identifier --- * Returns first_name, last_name, and email as extras --- -module Yesod.Auth.OAuth2.Learn - ( oauth2Learn - , module Yesod.Auth.OAuth2 - ) where - -import Control.Applicative ((<$>), (<*>)) -import Control.Exception.Lifted -import Control.Monad (mzero) -import Data.Aeson -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) -import Yesod.Auth -import Yesod.Auth.OAuth2 -import Network.HTTP.Conduit(Manager) -import qualified Data.Text as T - -data LearnUser = LearnUser - { learnUserId :: Int - , learnUserFirstName :: Text - , learnUserLastName :: Text - , learnUserEmail :: Text - } - -instance FromJSON LearnUser where - parseJSON (Object o) = - LearnUser <$> o .: "id" - <*> o .: "first_name" - <*> o .: "last_name" - <*> o .: "email" - - parseJSON _ = mzero - -data LearnResponse = LearnResponse LearnUser - -instance FromJSON LearnResponse where - parseJSON (Object o) = - LearnResponse <$> o .: "user" - - parseJSON _ = mzero - -oauth2Learn :: YesodAuth m - => Text -- ^ Client ID - -> Text -- ^ Client Secret - -> AuthPlugin m -oauth2Learn clientId clientSecret = authOAuth2 "learn" - (OAuth2 - { oauthClientId = encodeUtf8 clientId - , oauthClientSecret = encodeUtf8 clientSecret - , oauthOAuthorizeEndpoint = "http://learn.thoughtbot.com/oauth/authorize" - , oauthAccessTokenEndpoint = "http://learn.thoughtbot.com/oauth/token" - , oauthCallback = Nothing - }) - fetchLearnProfile - -fetchLearnProfile :: Manager -> AccessToken -> IO (Creds m) -fetchLearnProfile manager token = do - result <- authGetJSON manager token "http://learn.thoughtbot.com/api/v1/me.json" - - case result of - Right (LearnResponse user) -> return $ toCreds user - Left err -> throwIO $ InvalidProfileResponse "learn" err - -toCreds :: LearnUser -> Creds m -toCreds user = Creds "learn" - (T.pack $ show $ learnUserId user) - [ ("first_name", learnUserFirstName user) - , ("last_name" , learnUserLastName user) - , ("email" , learnUserEmail user) - ] diff --git a/Yesod/Auth/OAuth2/Upcase.hs b/Yesod/Auth/OAuth2/Upcase.hs new file mode 100644 index 0000000..e3c6ce3 --- /dev/null +++ b/Yesod/Auth/OAuth2/Upcase.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- +-- OAuth2 plugin for http://upcase.com +-- +-- * Authenticates against upcase +-- * Uses upcase user id as credentials identifier +-- * Returns first_name, last_name, and email as extras +-- +module Yesod.Auth.OAuth2.Upcase + ( oauth2Upcase + , module Yesod.Auth.OAuth2 + ) where + +import Control.Applicative ((<$>), (<*>)) +import Control.Exception.Lifted +import Control.Monad (mzero) +import Data.Aeson +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Yesod.Auth +import Yesod.Auth.OAuth2 +import Network.HTTP.Conduit(Manager) +import qualified Data.Text as T + +data UpcaseUser = UpcaseUser + { upcaseUserId :: Int + , upcaseUserFirstName :: Text + , upcaseUserLastName :: Text + , upcaseUserEmail :: Text + } + +instance FromJSON UpcaseUser where + parseJSON (Object o) = + UpcaseUser <$> o .: "id" + <*> o .: "first_name" + <*> o .: "last_name" + <*> o .: "email" + + parseJSON _ = mzero + +data UpcaseResponse = UpcaseResponse UpcaseUser + +instance FromJSON UpcaseResponse where + parseJSON (Object o) = + UpcaseResponse <$> o .: "user" + + parseJSON _ = mzero + +oauth2Upcase :: YesodAuth m + => Text -- ^ Client ID + -> Text -- ^ Client Secret + -> AuthPlugin m +oauth2Upcase clientId clientSecret = authOAuth2 "upcase" + OAuth2 + { oauthClientId = encodeUtf8 clientId + , oauthClientSecret = encodeUtf8 clientSecret + , oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize" + , oauthAccessTokenEndpoint = "http://upcase.com/oauth/token" + , oauthCallback = Nothing + } + 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 "upcase" + (T.pack $ show $ upcaseUserId user) + [ ("first_name", upcaseUserFirstName user) + , ("last_name" , upcaseUserLastName user) + , ("email" , upcaseUserEmail user) + ] diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal index 3bfd89a..b4eef8a 100644 --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -45,9 +45,9 @@ library , lifted-base >= 0.2 && < 0.4 exposed-modules: Yesod.Auth.OAuth2 - Yesod.Auth.OAuth2.Learn Yesod.Auth.OAuth2.Github Yesod.Auth.OAuth2.Spotify + Yesod.Auth.OAuth2.Upcase ghc-options: -Wall