From 15495d621328ca2deaa245e1960218cc69401e01 Mon Sep 17 00:00:00 2001
From: Felipe Lessa <felipe.lessa@gmail.com>
Date: Mon, 19 Dec 2011 09:50:02 -0200
Subject: [PATCH] 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
+-- (<https://developers.facebook.com/policy/>), 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