diff --git a/yesod-auth/Yesod/Auth/Facebook.hs b/yesod-auth/Yesod/Auth/Facebook.hs index 3928eb07..62737374 100644 --- a/yesod-auth/Yesod/Auth/Facebook.hs +++ b/yesod-auth/Yesod/Auth/Facebook.hs @@ -3,7 +3,9 @@ {-# LANGUAGE OverloadedStrings #-} module Yesod.Auth.Facebook ( authFacebook - , facebookUrl + , facebookLogin + , facebookLogout + , getFacebookAccessToken ) where #include "qq.h" @@ -17,20 +19,42 @@ import Data.Maybe (fromMaybe) import Yesod.Form import Yesod.Handler import Yesod.Widget -import Control.Monad.IO.Class (liftIO) +import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift) import Data.Text (Text) -import Control.Monad (mzero) +import Control.Monad (liftM, mzero, when) import Data.Monoid (mappend) import qualified Data.Aeson.Types import qualified Yesod.Auth.Message as Msg -facebookUrl :: AuthRoute -facebookUrl = PluginR "facebook" ["forward"] +-- | Route for login using this authentication plugin. +facebookLogin :: AuthRoute +facebookLogin = PluginR "facebook" ["forward"] +-- | Route for logout using this authentication plugin. Per +-- Facebook's policies +-- (), the user needs to +-- logout from Facebook itself as well. +facebookLogout :: AuthRoute +facebookLogout = PluginR "facebook" ["logout"] + +-- | Get Facebook's access token from the session. Returns +-- @Nothing@ if it's not found (probably because the user is not +-- logged in via Facebook). Note that the returned access token +-- may have expired. +getFacebookAccessToken :: MonadIO mo => GGHandler sub master mo (Maybe Facebook.AccessToken) +getFacebookAccessToken = + liftM (fmap Facebook.AccessToken) (lookupSession facebookAccessTokenKey) + +-- | Key used to store Facebook's access token in the client +-- session. +facebookAccessTokenKey :: Text +facebookAccessTokenKey = "_FB" + +-- | Authentication plugin using Facebook. authFacebook :: YesodAuth m - => Text -- ^ Application ID - -> Text -- ^ Application secret + => Text -- ^ Application ID + -> Text -- ^ Application secret -> [Text] -- ^ Requested permissions -> AuthPlugin m authFacebook cid secret perms = @@ -49,10 +73,24 @@ authFacebook cid secret perms = code <- runInputGet $ ireq textField "code" at <- liftIO $ Facebook.getAccessToken fb code let Facebook.AccessToken at' = at + setSession facebookAccessTokenKey at' so <- liftIO $ Facebook.getGraphData at "me" let c = fromMaybe (error "Invalid response from Facebook") $ parseMaybe (parseCreds at') $ either error id so setCreds True c + dispatch "GET" ["logout"] = do + m <- getYesod + tm <- getRouteToMaster + mtoken <- getFacebookAccessToken + when (redirectToReferer m) setUltDestReferer + case mtoken of + Nothing -> do + -- Well... then just logout from our app. + redirect RedirectTemporary (tm LogoutR) + Just at -> do + render <- getUrlRender + let logout = Facebook.getLogoutUrl at (render $ tm LogoutR) + redirectText RedirectTemporary logout dispatch _ _ = notFound login tm = do render <- lift getUrlRender diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index f9f6e820..b8bdcf88 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 0.7.7.2 +version: 0.8 license: BSD3 license-file: LICENSE author: Michael Snoyman, Patrick Brisbin @@ -21,9 +21,9 @@ library cpp-options: -DGHC7 else build-depends: base >= 4 && < 4.3 - build-depends: authenticate >= 0.10.3 && < 0.11 + build-depends: authenticate >= 0.10.4 && < 0.11 , bytestring >= 0.9.1.4 && < 0.10 - , yesod-core >= 0.9 && < 0.10 + , yesod-core >= 0.9.3.4 && < 0.10 , wai >= 0.4 && < 0.5 , template-haskell , pureMD5 >= 2.0 && < 2.2