yesod-auth-fb-1.10.1: Authentication backend for Yesod using Facebook.

Safe HaskellNone
LanguageHaskell98

Yesod.Auth.Facebook.ClientSide

Contents

Description

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.

WARNING: Currently this authentication plugin does not work with other authentication plugins. If you need many different authentication plugins, please try the server-side authentication flow (module Yesod.Auth.Facebook.ServerSide).

TODO: Explain how the whole thing fits together.

Synopsis

Authentication plugin

authFacebookClientSide :: YesodAuthFbClientSide site => AuthPlugin site Source #

Yesod authentication plugin using Facebook's client-side authentication flow.

You MUST use facebookJSSDK as its documentation states.

class (YesodAuth site, YesodFacebook site) => YesodAuthFbClientSide site where Source #

Type class that needs to be implemented in order to use authFacebookClientSide.

Minimal complete definition: getFbChannelFile. (We recommend implementing getFbLanguage as well.) class (YesodAuth site, YF.YesodFacebook site, MonadFail site) => YesodAuthFbClientSide site where

Minimal complete definition

getFbChannelFile

Methods

getFbChannelFile Source #

Arguments

:: HandlerT site IO (Route site)

Return channel file in the same subdomain as the current route.

A route that serves Facebook's channel file in the same subdomain as the current request's subdomain.

First of all, we recomment using serveChannelFile to implement the route's handler. For example, if your route is ChannelFileR, then you just need:

  getChannelFileR :: HandlerT site IO ChooseRep
  getChannelFileR = serveChannelFile

On most simple cases you may just implement fbChannelFile as

  getFbChannelFile = return ChannelFileR

However, if your routes span many subdomains, then you must have a channel file for each subdomain, otherwise your site won't work on old Internet Explorer versions (and maybe even on other browsers as well). That's why getFbChannelFile lives inside HandlerT.

getFbLanguage :: HandlerT site IO Text Source #

(Optional) Returns which language we should ask for Facebook's JS SDK. You may use information about the current request to decide upon a language. Defaults to "en_US".

If you already use Yesod's I18n capabilities, then there's an easy way of implementing this function. Just create a FbLanguage message, for example on your en.msg file:

  FbLanguage: en_US

and on your pt.msg file:

  FbLanguage: pt_BR

Then implement getFbLanguage as:

  getFbLanguage = ($ MsgFbLanguage) <$> getMessageRender

Although somewhat hacky, this trick works perfectly fine and guarantees that all Facebook messages will be in the same language as the rest of your site (even if Facebook support a language that you don't).

getFbInitOpts :: HandlerT site IO [(Text, Value)] Source #

(Optional) Options that should be given to FB.init(). The default implementation is defaultFbInitOpts. If you intend to override this function, we advise you to also call defaultFbInitOpts, e.g.:

    getFbInitOpts = do
      defOpts <- defaultFbInitOpts
      ...
      return (defOpts ++ myOpts)

However, if you know what you're doing you're free to override any or all values returned by defaultFbInitOpts.

fbAsyncInitJs :: JavascriptUrl (Route site) Source #

(Optional) Arbitrary JavaScript that will be called on Facebook's JS SDK's fbAsyncInit (i.e. as soon as their SDK is loaded).

Widgets

facebookJSSDK :: YesodAuthFbClientSide site => (Route Auth -> Route site) -> WidgetT site IO () Source #

Hamlet that should be spliced right after the body tag in order for Facebook's JS SDK to work. For example:

  $doctype 5
  <html>
    <head>
      ...
    <body>
      ^{facebookJSSDK AuthR}
      ...

Facebook's JS SDK may not work correctly if you place it anywhere else on the body. If you absolutely need to do so, avoid any elements placed with position: relative or position: absolute.

facebookLogin :: [Permission] -> JavaScriptCall Source #

JavaScript function that should be called in order to login the user. You could splice this into a onclick event, for example:

  <a href="#" onclick="#{facebookLogin perms}">
    Login via Facebook

You should not call this function if the user is already logged in.

This is only a helper around Facebook JS SDK's FB.login(), you may call that function directly if you prefer.

facebookForceLoginR :: [Permission] -> Route Auth Source #

Route that forces the user to log in. You should avoid using this route whenever possible, using facebookLogin is much better (after all, this module is for client-side authentication). However, you may want to use it at least for authRoute, e.g.:

instance Yesod MyFoundation where
  ...
  authRoute _ = Just $ AuthR (facebookForceLoginR [])

facebookLogout :: JavaScriptCall Source #

JavaScript function that should be called in order to logout the user. You could splice the result of this widget into a onclick event, for example:

  <a href="#" onclick="#{facebookLogout}">
    Logout

This function used to be just a helper around Facebook JS SDK's FB.logout(). However, now it performs a check to see if the user is logged via FB and redirects to yesod-auth's normal LogoutR route if not.

type JavaScriptCall = Text Source #

A JavaScript function call.

Useful functions

serveChannelFile :: HandlerT site IO TypedContent Source #

Facebook's channel file implementation (see https://developers.facebook.com/docs/reference/javascript/).

Note that we set an expire time in the far future, so you won't be able to re-use this route again. No common users will see this route, so you may use anything.

defaultFbInitOpts :: YesodAuthFbClientSide site => HandlerT site IO [(Text, Value)] Source #

Default implementation for getFbInitOpts. Defines:

appId
Using getFbCredentials.
channelUrl
Using getFbChannelFile.
cookie
To True. This one is extremely important and this module won't work at all without it.
status
To True, since this usually is what you want.

Access tokens

extractCredsAccessToken :: Creds m -> Maybe UserAccessToken Source #

Get the user access token from a Creds created by this backend. This function should be used on getAuthId.

getUserAccessTokenFromFbCookie :: YesodAuthFbClientSide site => AuthHandler site (Either String UserAccessToken) Source #

Get the Facebook's user access token from Facebook's cookie. Returns Left if the cookie is not found, is not authentic, is for another app, is corrupted or does not contains the information needed (maybe the user is not logged in). Note that the returned access token may have expired, we recommend using hasExpired and isValid.

This getUserAccessTokenFromFbCookie is completely different from the one from the Yesod.Auth.Facebook.ServerSide module. This one does not use only the session, which means that (a) it's somewhat slower because everytime you call this getUserAccessTokenFromFbCookie it needs to reverify the cookie, but (b) it is always up-to-date with the latest cookie that the Facebook JS SDK has given us and (c) avoids duplicating the information from the cookie into the session.

Note also that getUserAccessTokenFromFbCookie may return Left even tough the user is properly logged in. When you force authentication via facebookForceLoginR (e.g., via 'requireAuth'/'requireAuthId') we use the server-side flow which will not set the cookie until at least the FB JS SDK runs on the user-agent, sets the cookie and another request is sent to our servers.

For the reason stated on the previous paragraph, you should not use this function on getAuthId. Instead, you should use extractCredsAccessToken.

Advanced

signedRequestCookieName :: Credentials -> Text Source #

Cookie name with the signed request for the given credentials.