Merge pull request #185 from meteficha/facebook-logout

Facebook logout support and access token.

yesod-auth/Yesod/Auth/Facebook.hs

@@ -3,7 +3,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Yesod.Auth.Facebook
     ( authFacebook
+    , facebookLogin
     , facebookUrl
+    , facebookLogout
+    , getFacebookAccessToken
     ) where
 
 #include "qq.h"
@@ -17,20 +20,48 @@ 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
+-- | Route for login using this authentication plugin.
-facebookUrl = PluginR "facebook" ["forward"]
+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
+-- (<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 ID
-             -> Text -- ^ Application secret
+             -> Text   -- ^ Application secret
              -> [Text] -- ^ Requested permissions
              -> AuthPlugin m
 authFacebook cid secret perms =
@@ -49,10 +80,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

yesod-auth/yesod-auth.cabal

@@ -1,5 +1,5 @@
 name:            yesod-auth
-version:         0.7.7.2
+version:         0.7.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