From 15495d621328ca2deaa245e1960218cc69401e01 Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 19 Dec 2011 09:50:02 -0200 Subject: [PATCH 1/2] Facebook logout support and access token. This patch renames "facebookUrl" to "facebookLogin" and adds "facebookLogout". The latter logs out the user from Facebook as well to comply with Facebook's policies. As a bonus, we also save the user's access token into their session and export "getFacebookAccessToken". Besides being useful for the application, this is necessary for the new logout action. This patch also bumps the version to 0.8 since we have renamed "facebookUrl". --- yesod-auth/Yesod/Auth/Facebook.hs | 52 ++++++++++++++++++++++++++----- yesod-auth/yesod-auth.cabal | 6 ++-- 2 files changed, 48 insertions(+), 10 deletions(-) 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 From 9a9d063d3e2b992b733098a0b9f4009cbba8a8da Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Mon, 19 Dec 2011 14:04:51 -0200 Subject: [PATCH 2/2] Re-export facebookLogin as facebookUrl in yesod-auth's Facebook. Now facebookUrl is deprecated and provided only for backwards compatibility. This also allows us to bump yesod-auth's version back to 0.7.*. --- yesod-auth/Yesod/Auth/Facebook.hs | 7 +++++++ yesod-auth/yesod-auth.cabal | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/yesod-auth/Yesod/Auth/Facebook.hs b/yesod-auth/Yesod/Auth/Facebook.hs index 62737374..c4dbd1c0 100644 --- a/yesod-auth/Yesod/Auth/Facebook.hs +++ b/yesod-auth/Yesod/Auth/Facebook.hs @@ -4,6 +4,7 @@ module Yesod.Auth.Facebook ( authFacebook , facebookLogin + , facebookUrl , facebookLogout , getFacebookAccessToken ) where @@ -31,6 +32,12 @@ import qualified Yesod.Auth.Message as Msg facebookLogin :: AuthRoute facebookLogin = PluginR "facebook" ["forward"] +-- | This is just a synonym of 'facebookLogin'. Deprecated since +-- @yesod-auth 0.7.8@, please use 'facebookLogin' instead. +facebookUrl :: AuthRoute +facebookUrl = facebookLogin +{-# DEPRECATED facebookUrl "Please use facebookLogin instead." #-} + -- | Route for logout using this authentication plugin. Per -- Facebook's policies -- (), the user needs to diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index b8bdcf88..8f3d1e67 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 0.8 +version: 0.7.8 license: BSD3 license-file: LICENSE author: Michael Snoyman, Patrick Brisbin