diff --git a/Yesod/Auth/OAuth2.hs b/Yesod/Auth/OAuth2.hs index fabb3b8..96c56cb 100644 --- a/Yesod/Auth/OAuth2.hs +++ b/Yesod/Auth/OAuth2.hs @@ -1,21 +1,25 @@ {-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +-- | +-- +-- Generic OAuth2 plugin for Yesod +-- +-- * See Yesod.Auth.OAuth2.Learn for example usage. +-- module Yesod.Auth.OAuth2 ( authOAuth2 , oauth2Url - , oauth2Google - , oauth2Learn , module Network.OAuth.OAuth2 ) where import Control.Monad.IO.Class -import Data.ByteString (ByteString) -import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) -import Yesod.Auth -import Yesod.Form -import Yesod.Core import Network.OAuth.OAuth2 +import Yesod.Auth +import Yesod.Core +import Yesod.Form oauth2Url :: Text -> AuthRoute oauth2Url name = PluginR name ["forward"] @@ -30,7 +34,7 @@ authOAuth2 :: YesodAuth m -- authorized request to @api/me.json@. -> (AccessToken -> IO (Creds m)) -> AuthPlugin m -authOAuth2 name oauth mkCreds = AuthPlugin name dispatch login +authOAuth2 name oauth getCreds = AuthPlugin name dispatch login where url = PluginR name ["callback"] @@ -51,7 +55,7 @@ authOAuth2 name oauth mkCreds = AuthPlugin name dispatch login case result of Left _ -> permissionDenied "Unable to retreive OAuth2 token" Right token -> do - creds <- liftIO $ mkCreds token + creds <- liftIO $ getCreds token lift $ setCreds True creds dispatch _ _ = notFound @@ -61,23 +65,5 @@ authOAuth2 name oauth mkCreds = AuthPlugin name dispatch login let oaUrl = render $ tm $ oauth2Url name [whamlet| Login via #{name} |] -oauth2Google :: Text -> Text -> OAuth2 -oauth2Google clientId clientSecret = OAuth2 - { oauthClientId = encodeUtf8 clientId - , oauthClientSecret = encodeUtf8 clientSecret - , oauthOAuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" - , oauthAccessTokenEndpoint = "https://accounts.google.com/o/oauth2/token" - , oauthCallback = Nothing - } - -oauth2Learn :: Text -> Text -> OAuth2 -oauth2Learn clientId clientSecret = OAuth2 - { oauthClientId = encodeUtf8 clientId - , oauthClientSecret = encodeUtf8 clientSecret - , oauthOAuthorizeEndpoint = "http://learn.thoughtbot.com/oauth/authorize" - , oauthAccessTokenEndpoint = "http://learn.thoughtbot.com/oauth/token" - , oauthCallback = Nothing - } - bsToText :: ByteString -> Text bsToText = decodeUtf8With lenientDecode diff --git a/Yesod/Auth/OAuth2/Google.hs b/Yesod/Auth/OAuth2/Google.hs new file mode 100644 index 0000000..662849e --- /dev/null +++ b/Yesod/Auth/OAuth2/Google.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- +-- OAuth2 plugin for http://google.com +-- +-- * Note: this module is unfinished, do not use. +-- +module Yesod.Auth.OAuth2.Google + ( oauth2Google + , module Yesod.Auth.OAuth2 + ) where + +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Yesod.Auth +import Yesod.Auth.OAuth2 + +oauth2Google :: YesodAuth m + => Text -- ^ Client ID + -> Text -- ^ Client Secret + -> AuthPlugin m +oauth2Google clientId clientSecret = authOAuth2 "google" + (OAuth2 + { oauthClientId = encodeUtf8 clientId + , oauthClientSecret = encodeUtf8 clientSecret + , oauthOAuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" + , oauthAccessTokenEndpoint = "https://accounts.google.com/o/oauth2/token" + , oauthCallback = Nothing + }) + undefined -- TODO diff --git a/Yesod/Auth/OAuth2/Learn.hs b/Yesod/Auth/OAuth2/Learn.hs new file mode 100644 index 0000000..e876006 --- /dev/null +++ b/Yesod/Auth/OAuth2/Learn.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- +-- OAuth2 plugin for http://learn.thoughbot.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.Monad (mzero) +import Data.Aeson +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Yesod.Auth +import Yesod.Auth.OAuth2 +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 :: AccessToken -> IO (Creds m) +fetchLearnProfile token = do + result <- authGetJSON token "http://learn.thoughtbot.com/api/v1/me.json" + + case result of + Right (LearnResponse user) -> return $ toCreds user + _ -> error "Invalid response for learn profile data" + +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.cabal b/yesod-auth-oauth2.cabal index d093703..f11daf4 100644 --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -33,6 +33,8 @@ library , hoauth2 >= 0.3.6 && < 0.4 exposed-modules: Yesod.Auth.OAuth2 + Yesod.Auth.OAuth2.Google + Yesod.Auth.OAuth2.Learn ghc-options: -Wall