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".
This commit is contained in:
parent
558068374d
commit
15495d6213
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user