diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,3 +4,75 @@ [![Build Status](https://travis-ci.org/psibi/yesod-auth-fb.svg?branch=master)](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| +

Your current auth ID: #{show maid} + $maybe _ <- maid +

+ Logout + Facebook logout + $nothing +

+ Go to the login page + |] + +main :: IO () +main = warp 3000 App +``` diff --git a/src/Yesod/Auth/Facebook/ClientSide.hs b/src/Yesod/Auth/Facebook/ClientSide.hs --- a/src/Yesod/Auth/Facebook/ClientSide.hs +++ b/src/Yesod/Auth/Facebook/ClientSide.hs @@ -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 -- . @@ -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 diff --git a/src/Yesod/Auth/Facebook/ServerSide.hs b/src/Yesod/Auth/Facebook/ServerSide.hs --- a/src/Yesod/Auth/Facebook/ServerSide.hs +++ b/src/Yesod/Auth/Facebook/ServerSide.hs @@ -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|_{Msg.Facebook} -|] + |] + -- | Create an @yesod-auth@'s 'Creds' for a given diff --git a/yesod-auth-fb.cabal b/yesod-auth-fb.cabal --- a/yesod-auth-fb.cabal +++ b/yesod-auth-fb.cabal @@ -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