yesod-auth-fb (empty) → 0.0
raw patch · 6 files changed
+233/−0 lines, 6 filesdep +basedep +fbdep +http-conduitsetup-changed
Dependencies added: base, fb, http-conduit, text, transformers, wai, yesod-auth, yesod-core
Files
- LICENSE +30/−0
- README +0/−0
- Setup.hs +2/−0
- include/qq.h +11/−0
- src/Yesod/Auth/FB.hs +142/−0
- yesod-auth-fb.cabal +48/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Felipe Lessa++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Felipe Lessa nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ include/qq.h view
@@ -0,0 +1,11 @@+-- Stolen from yesod-auth.+--+-- CPP macro which choses which quasyquotes syntax to use depending+-- on GHC version.+--+-- QQ stands for quasiquote.+#if GHC7+# define QQ(x) x+#else+# define QQ(x) $x+#endif
+ src/Yesod/Auth/FB.hs view
@@ -0,0 +1,142 @@+module Yesod.Auth.FB+ ( authFacebook+ , facebookLogin+ , facebookLogout+ , getUserAccessToken+ , setUserAccessToken+ ) where++#include "qq.h"+import Control.Applicative ((<$>))+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Maybe (MaybeT(..))+import Data.Monoid (mappend)+import Data.Text (Text)+import Network.Wai (queryString)+import Yesod.Auth+import Yesod.Handler+import Yesod.Widget+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Facebook as FB+import qualified Network.HTTP.Conduit as H+import qualified Yesod.Auth.Message as Msg+++-- | Route for login using this authentication plugin.+facebookLogin :: AuthRoute+facebookLogin = PluginR "fb" ["login"]+++-- | Route for logout using this authentication plugin. At the+-- time of writing, Facebook's policies+-- (<https://developers.facebook.com/policy/>) specified that the+-- user needs to be logged out from Facebook itself as well.+facebookLogout :: AuthRoute+facebookLogout = PluginR "fb" ["logout"]+++-- | Yesod authentication plugin using Facebook.+authFacebook :: YesodAuth master+ => FB.Credentials -- ^ Your application's credentials.+ -> H.Manager -- ^ HTTP connection manager.+ -> [FB.Permission] -- ^ Permissions to be requested.+ -> AuthPlugin master+authFacebook creds manager perms = AuthPlugin "fb" dispatch login+ where+ -- Get the URL in facebook.com where users are redirected to.+ getRedirectUrl :: (YesodAuth master, Monad m) =>+ (Route Auth -> Route master)+ -> GGHandler sub master m Text+ getRedirectUrl tm = do+ render <- getUrlRender+ let proceedUrl = render (tm proceedR)+ return $ FB.getUserAccessTokenStep1 creds proceedUrl perms+ proceedR = PluginR "fb" ["proceed"]++ -- Redirect the user to Facebook.+ dispatch "GET" ["login"] =+ redirectText RedirectTemporary =<< getRedirectUrl =<< getRouteToMaster+ -- Take Facebook's code and finish authentication.+ dispatch "GET" ["proceed"] = do+ tm <- getRouteToMaster+ render <- getUrlRender+ query <- queryString <$> waiRequest+ let proceedUrl = render (tm proceedR)+ query' = [(a,b) | (a, Just b) <- query]+ token <- liftIO $+ FB.runFacebookT creds manager $+ FB.getUserAccessTokenStep2 proceedUrl query'+ setUserAccessToken token+ setCreds True (createCreds token)+ -- Logout the user from our site and from Facebook.+ dispatch "GET" ["logout"] = do+ m <- getYesod+ tm <- getRouteToMaster+ mtoken <- getUserAccessToken+ when (redirectToReferer m) setUltDestReferer++ -- Facebook doesn't redirect back to our chosen address+ -- when the user access token is invalid, so we need to+ -- check its validity before anything else.+ let isValid = liftIO .+ FB.runNoAuthFacebookT manager .+ FB.isValid+ valid <- maybe (return False) isValid mtoken++ case (valid, mtoken) of+ (True, Just token) -> do+ render <- getUrlRender+ redirectText RedirectTemporary $+ FB.getUserLogoutUrl token (render $ tm LogoutR)+ _ -> redirect RedirectTemporary (tm LogoutR)+ -- Anything else gives 404+ dispatch _ _ = notFound++ -- Small widget for multiple login websites.+ login :: YesodAuth master =>+ (Route Auth -> Route master)+ -> GWidget sub master ()+ login tm = do+ redirectUrl <- lift (getRedirectUrl tm)+ [QQ(whamlet)|+<p>+ <a href="#{redirectUrl}">_{Msg.Facebook}+|]+++-- | Create an @yesod-auth@'s 'Creds' for a given+-- @'FB.AccessToken' 'FB.User'@.+createCreds :: FB.UserAccessToken -> Creds m+createCreds (FB.UserAccessToken userId _ _) = Creds "fb" id_ []+ where id_ = "http://graph.facebook.com/" `mappend` TE.decodeUtf8 userId+++-- | Set the Facebook's user access token on the user's session.+-- Usually you don't need to call this function, but it may+-- become handy together with 'FB.extendUserAccessToken'.+setUserAccessToken :: MonadIO m =>+ FB.UserAccessToken+ -> GGHandler sub master m ()+setUserAccessToken (FB.UserAccessToken userId data_ exptime) = do+ setSession "_FBID" (TE.decodeUtf8 userId)+ setSession "_FBAT" (TE.decodeUtf8 data_)+ setSession "_FBET" (T.pack $ show exptime)+++-- | Get the Facebook's user access token from the session.+-- Returns @Nothing@ if it's not found (probably because the user+-- is not logged in via @yesod-auth-fb@). Note that the returned+-- access token may have expired, we recommend using+-- 'FB.hasExpired' and 'FB.isValid'.+getUserAccessToken :: MonadIO mo =>+ GGHandler sub master mo (Maybe FB.UserAccessToken)+getUserAccessToken = runMaybeT $ do+ userId <- MaybeT $ lookupSession "_FBID"+ data_ <- MaybeT $ lookupSession "_FBAT"+ exptime <- MaybeT $ lookupSession "_FBET"+ return $ FB.UserAccessToken (TE.encodeUtf8 userId)+ (TE.encodeUtf8 data_)+ (read $ T.unpack exptime)
+ yesod-auth-fb.cabal view
@@ -0,0 +1,48 @@+Name: yesod-auth-fb+Version: 0.0+Synopsis: [PREVIEW] Authentication backend for Yesod using Facebook.+Homepage: https://github.com/meteficha/yesod-auth-fb+License: BSD3+License-file: LICENSE+Author: Felipe Lessa, Michael Snoyman+Maintainer: Felipe Lessa <felipe.lessa@gmail.com>+Category: Web+Build-type: Simple+Cabal-version: >= 1.6+Extra-source-files: include/qq.h, README++Description:+ /THIS IS A PREVIEW RELEASE!/+ .+ This package allows you to use Yesod's authentication framework+ with Facebook as your backend. That is, your site's users will+ log in to your site through Facebook. Your application need to+ be registered on Facebook.++Source-repository head+ type: git+ location: git://github.com/meteficha/yesod-auth-fb.git++flag ghc7++Library+ hs-source-dirs: src++ if flag(ghc7)+ Cpp-options: -DGHC7+ Build-depends: base >= 4.3 && < 5+ else+ Build-depends: base >= 4 && < 4.3++ Build-depends: yesod-core >= 0.9 && < 0.10+ , yesod-auth >= 0.7 && < 0.8+ , wai+ , http-conduit+ , text >= 0.7 && < 0.12+ , transformers >= 0.1.3 && < 0.3+ , fb >= 0.6.0.1 && < 0.7++ Exposed-modules: Yesod.Auth.FB+ Extensions: GADTs QuasiQuotes CPP OverloadedStrings+ GHC-options: -Wall+ Include-dirs: include