yesod-auth-fb 1.8.1 → 1.9.0
raw patch · 5 files changed
+139/−49 lines, 5 filesdep +resourcetdep +unliftiodep −lifted-basedep ~basedep ~conduitdep ~fb
Dependencies added: resourcet, unliftio
Dependencies removed: lifted-base
Dependency ranges changed: base, conduit, fb, yesod-auth, yesod-core, yesod-fb
Files
- CHANGELOG.md +6/−0
- README.md +72/−0
- src/Yesod/Auth/Facebook/ClientSide.hs +25/−18
- src/Yesod/Auth/Facebook/ServerSide.hs +26/−22
- yesod-auth-fb.cabal +10/−9
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Version 1.9.0++* Supports conduit >= 1.3.0+* Documentation updated to include demo code.+* Supports latest yesod >= 1.6.0.+* Remove dependency on lifted-base and related ecosystem.
README.md view
@@ -4,3 +4,75 @@ [](https://travis-ci.org/psibi/yesod-auth-fb) Authentication backend for Yesod using Facebook++# Demo++Sample code showing Facebook authentication in action:++```+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}++import Data.Text (Text)+import Yesod+import Yesod.Auth+import Yesod.Facebook+import Yesod.Auth.Facebook.ServerSide+import Facebook (Credentials(..))++fbclientId :: Text+fbclientId = "sample_fb_client_id"++fbclientSecret :: Text+fbclientSecret = "sample_fb_secret"++data App =+ App++mkYesod+ "App"+ [parseRoutes|+/ HomeR GET+/auth AuthR Auth getAuth+|]++instance Yesod App where+ approot = ApprootStatic "http://localhost:3000"++instance YesodFacebook App where+ fbCredentials _ = Credentials "yesod" fbclientId fbclientSecret++instance YesodAuth App where+ type AuthId App = Text+ getAuthId = return . Just . credsIdent+ loginDest _ = HomeR+ logoutDest _ = HomeR+ authPlugins _ = [authFacebook ["user_about_me", "email"]]+ -- The default maybeAuthId assumes a Persistent database. We're going for a+ -- simpler AuthId, so we'll just do a direct lookup in the session.+ maybeAuthId = lookupSession "_ID"++instance RenderMessage App FormMessage where+ renderMessage _ _ = defaultFormMessage++getHomeR :: Handler Html+getHomeR = do+ maid <- maybeAuthId+ defaultLayout+ [whamlet|+ <p>Your current auth ID: #{show maid}+ $maybe _ <- maid+ <p>+ <a href=@{AuthR LogoutR}>Logout+ <a href=@{AuthR facebookLogout}>Facebook logout+ $nothing+ <p>+ <a href=@{AuthR LoginR}>Go to the login page+ |]++main :: IO ()+main = warp 3000 App+```
src/Yesod/Auth/Facebook/ClientSide.hs view
@@ -1,3 +1,6 @@+{-#LANGUAGE RankNTypes#-}+{-#LANGUAGE ScopedTypeVariables#-}+ -- | @yesod-auth@ authentication plugin using Facebook's -- client-side authentication flow. You may see a demo at -- <https://github.com/meteficha/yesod-auth-fb/blob/master/demo/clientside.hs>.@@ -43,7 +46,8 @@ import Text.Julius (JavascriptUrl, julius, rawJS) import Yesod.Auth import Yesod.Core-import qualified Control.Exception.Lifted as E+import qualified Control.Monad.Trans.Resource as R+import qualified UnliftIO.Exception as E import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import qualified Data.Text as T@@ -358,37 +362,38 @@ -- authentication flow. -- -- You /MUST/ use 'facebookJSSDK' as its documentation states.+ authFacebookClientSide :: YesodAuthFbClientSide site => AuthPlugin site authFacebookClientSide = AuthPlugin "fbcs" dispatch login where dispatch :: YesodAuthFbClientSide site =>- Text -> [Text] -> HandlerT Auth (HandlerT site IO) TypedContent+ Text -> [Text] -> AuthHandler site TypedContent -- Login route used when successfully logging in. Called via -- AJAX by JavaScript code on 'facebookJSSDK'. dispatch "GET" ["login"] = do- y <- lift getYesod- when (redirectToReferer y) (lift setUltDestReferer)- etoken <- lift getUserAccessTokenFromFbCookie+ y <- getYesod+ when (redirectToReferer y) setUltDestReferer+ etoken <- getUserAccessTokenFromFbCookie case etoken of- Right token -> lift $ setCredsRedirect (createCreds token)+ Right token -> setCredsRedirect (createCreds token) Left msg -> fail msg -- Login routes used to forcefully require the user to login. dispatch "GET" ["login", "go"] = dispatch "GET" ["login", "go", ""] dispatch "GET" ["login", "go", perms] = do -- Redirect the user to the server-side flow login url.- y <- lift getYesod- ur <- getUrlRender- when (redirectToReferer y) (lift setUltDestReferer)- let redirectTo = ur $ fbcsR ["login", "back"]+ y <- getYesod+ (ur :: Route site -> FB.RedirectUrl) <- getUrlRender+ (tm :: Route Auth -> Route site) <- getRouteToParent+ when (redirectToReferer y) setUltDestReferer+ let redirectTo = ur $ tm $ fbcsR ["login", "back"] uncommas "" = [] uncommas xs = case break (== ',') xs of (x', ',':xs') -> x' : uncommas xs' (x', _) -> [x']- url <- lift $- YF.runYesodFbT $+ url <- liftSubHandler $ YF.runYesodFbT $ FB.getUserAccessTokenStep1 redirectTo $ map fromString $ uncommas $ T.unpack perms redirect url@@ -400,13 +405,13 @@ -- flimsy and sometimes the user landed on a blank page due -- to race conditions. ur <- getUrlRender+ tm <- getRouteToParent query <- queryString <$> waiRequest- let proceedUrl = ur $ fbcsR ["login", "back"]+ let proceedUrl = ur $ tm $ fbcsR ["login", "back"] query' = [(a,b) | (a, Just b) <- query]- token <- lift $- YF.runYesodFbT $- FB.getUserAccessTokenStep2 proceedUrl query'- lift $ setCredsRedirect (createCreds token)+ token <- liftSubHandler $ YF.runYesodFbT $+ (FB.getUserAccessTokenStep2 proceedUrl query')+ setCredsRedirect (createCreds token) -- Everything else gives 404 dispatch _ _ = notFound@@ -494,12 +499,13 @@ -- 'extractCredsAccessToken'. getUserAccessTokenFromFbCookie :: YesodAuthFbClientSide site =>- HandlerT site IO (Either String FB.UserAccessToken)+ AuthHandler site (Either String FB.UserAccessToken) getUserAccessTokenFromFbCookie = runErrorT $ do creds <- lift YF.getFbCredentials unparsed <- toErrorT "cookie not found" $ lookupCookie (signedRequestCookieName creds) A.Object parsed <- toErrorT "cannot parse signed request" $+ liftSubHandler $ YF.runYesodFbT $ FB.parseSignedRequest (TE.encodeUtf8 unparsed) case (flip A.parseEither () $ const $@@ -526,6 +532,7 @@ token <- ErrorT $ fmap (either (Left . fbErrorMsg) Right) $ E.try $+ liftSubHandler $ YF.runYesodFbT $ FB.getUserAccessTokenStep2 "" [("code", code)] case token of
src/Yesod/Auth/Facebook/ServerSide.hs view
@@ -1,3 +1,5 @@+{-#LANGUAGE RankNTypes#-}+ -- | @yesod-auth@ authentication plugin using Facebook's -- server-side authentication flow. module Yesod.Auth.Facebook.ServerSide@@ -50,45 +52,46 @@ authFacebook perms = AuthPlugin "fb" dispatch login where -- Get the URL in facebook.com where users are redirected to.- getRedirectUrl :: YF.YesodFacebook site => (Route Auth -> Text) -> HandlerT site IO Text- getRedirectUrl render =- YF.runYesodFbT $ FB.getUserAccessTokenStep1 (render proceedR) perms+ getRedirectUrl :: YF.YesodFacebook site => (Route site -> Text) -> (Route Auth -> Route site) -> AuthHandler site Text+ getRedirectUrl render proute =+ YF.runYesodFbT $ FB.getUserAccessTokenStep1 (render $ proute proceedR) perms proceedR = PluginR "fb" ["proceed"] dispatch :: (YesodAuth site, YF.YesodFacebook site) =>- Text -> [Text] -> HandlerT Auth (HandlerT site IO) TypedContent+ Text -> [Text] -> AuthHandler site TypedContent -- Redirect the user to Facebook. dispatch "GET" ["login"] = do ur <- getUrlRender- lift $ do- y <- getYesod- when (redirectToReferer y) setUltDestReferer- redirect =<< getRedirectUrl ur+ tm <- getRouteToParent+ y <- getYesod+ when (redirectToReferer y) setUltDestReferer+ redirect =<< getRedirectUrl ur tm -- Take Facebook's code and finish authentication. dispatch "GET" ["proceed"] = do render <- getUrlRender+ tm <- getRouteToParent query <- queryString <$> waiRequest- let proceedUrl = render proceedR+ let proceedUrl = render $ tm proceedR query' = [(a,b) | (a, Just b) <- query]- lift $ do- token <- YF.runYesodFbT $ FB.getUserAccessTokenStep2 proceedUrl query'- setUserAccessToken token- setCredsRedirect (createCreds token)+ token <- liftSubHandler $ YF.runYesodFbT $ FB.getUserAccessTokenStep2 proceedUrl query'+ setUserAccessToken token+ setCredsRedirect (createCreds token) -- Logout the user from our site and from Facebook. dispatch "GET" ["logout"] = do- y <- lift getYesod- mtoken <- lift getUserAccessToken- when (redirectToReferer y) (lift setUltDestReferer)+ y <- getYesod+ mtoken <- getUserAccessToken+ when (redirectToReferer y) (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.- valid <- maybe (return False) (lift . YF.runYesodFbT . FB.isValid) mtoken+ valid <- maybe (return False) (YF.runYesodFbT . FB.isValid) mtoken case (valid, mtoken) of (True, Just token) -> do render <- getUrlRender- dest <- lift $ YF.runYesodFbT $ FB.getUserLogoutUrl token (render $ PluginR "fb" ["kthxbye"])+ tm <- getRouteToParent+ dest <- YF.runYesodFbT $ FB.getUserLogoutUrl token (render $ tm $ PluginR "fb" ["kthxbye"]) redirect dest _ -> dispatch "GET" ["kthxbye"] -- Finish the logout procedure. Unfortunately we have to@@ -97,7 +100,7 @@ -- LogoutR since it would otherwise call setUltDestReferrer -- again. dispatch "GET" ["kthxbye"] =- lift $ do+ do m <- getYesod deleteSession "_ID" deleteUserAccessToken@@ -109,12 +112,13 @@ -- Small widget for multiple login websites. login :: (YesodAuth site, YF.YesodFacebook site) => (Route Auth -> Route site)- -> WidgetT site IO ()+ -> WidgetFor site () login tm = do ur <- getUrlRender- redirectUrl <- handlerToWidget $ getRedirectUrl (ur . tm)+ redirectUrl <- handlerToWidget $ YF.runYesodFbT $ FB.getUserAccessTokenStep1 (ur $ tm proceedR) perms [whamlet|<a href="#{redirectUrl}">_{Msg.Facebook}-|]+ |]+ -- | Create an @yesod-auth@'s 'Creds' for a given
yesod-auth-fb.cabal view
@@ -1,5 +1,5 @@ Name: yesod-auth-fb-Version: 1.8.1+Version: 1.9.0 Synopsis: Authentication backend for Yesod using Facebook. Homepage: https://github.com/psibi/yesod-auth-fb License: BSD3@@ -9,7 +9,7 @@ Category: Web Build-type: Simple Cabal-version: >= 1.6-Extra-source-files: README.md, demo/clientside.hs+Extra-source-files: README.md, demo/clientside.hs, CHANGELOG.md Description: This package allows you to use Yesod's authentication framework@@ -40,21 +40,22 @@ Library hs-source-dirs: src - Build-depends: base >= 4.3 && < 5- , lifted-base >= 0.1 && < 0.3- , yesod-core >= 1.2 && < 1.5- , yesod-auth >= 1.3 && < 1.5+ Build-depends: base >= 4.9.0 && < 5+ , yesod-core >= 1.6.1+ , yesod-auth >= 1.6.1 , shakespeare >= 2.0 , wai , http-conduit >= 1.9 , text >= 0.7 && < 1.3 , transformers >= 0.1.3 && < 0.6- , yesod-fb >= 0.4.0- , fb >= 1.1.0- , conduit >= 1.0 && < 1.3+ , yesod-fb >= 0.5.0+ , fb >= 1.2.0+ , conduit >= 1.3.0 , bytestring >= 0.9 && < 0.11 , aeson >= 0.6 , time >= 1.0 && < 1.9+ , unliftio+ , resourcet >= 1.2.0 Exposed-modules: Yesod.Auth.Facebook , Yesod.Auth.Facebook.ClientSide