packages feed

yesod-auth-fb 1.4 → 1.5

raw patch · 2 files changed

+79/−37 lines, 2 files

Files

src/Yesod/Auth/Facebook/ClientSide.hs view
@@ -23,8 +23,11 @@       -- * Useful functions     , serveChannelFile     , defaultFbInitOpts-    , getUserAccessToken +      -- * Access tokens+    , extractCredsAccessToken+    , getUserAccessTokenFromFbCookie+       -- * Advanced     , signedRequestCookieName     ) where@@ -37,8 +40,8 @@ import Data.Monoid (mappend, mempty) import Data.String (fromString) import Data.Text (Text)+import Network.Wai (queryString) import System.Locale (defaultTimeLocale)-import Text.Hamlet (hamlet) import Text.Julius (JavascriptUrl, julius, rawJS) import Yesod.Auth import Yesod.Content@@ -53,7 +56,6 @@ import qualified Facebook as FB import qualified Yesod.Facebook as YF import qualified Yesod.Auth.Message as Msg--- import qualified Data.Conduit as C   -- | Internal function.  Construct a route to our plugin.@@ -364,7 +366,7 @@     dispatch "GET" ["login"] = do       y <- getYesod       when (redirectToReferer y) setUltDestReferer-      etoken <- getUserAccessToken+      etoken <- getUserAccessTokenFromFbCookie       case etoken of         Right token -> setCreds True (createCreds token)         Left msg -> fail msg@@ -387,22 +389,19 @@                map fromString $ uncommas $ T.unpack perms       redirect url     dispatch "GET" ["login", "back"] = do-      -- Instead of going on with the server-side flow, use the-      -- client-side JS to finish the authentication.+      -- We used to use the client-side flow to finish the+      -- authentication.  The advantage was simplifying the rest+      -- of the code which didn't need to know about the use of+      -- the server-side flow above.  However, this was very+      -- flimsy and sometimes the user landed on a blank page due+      -- to race conditions.+      ur <- getUrlRender       tm <- getRouteToMaster-      mr <- getMessageRender-      fbjssdkpc <- widgetToPageContent (facebookJSSDK tm)-      rephtml <- hamletToRepHtml $ [hamlet|$newline never-        $doctype 5-        <html>-          <head>-            <title>#{mr Msg.LoginTitle}-            ^{pageHead fbjssdkpc}-          <body>-            ^{pageBody fbjssdkpc}-        |]-      sendResponse rephtml-+      query <- queryString <$> waiRequest+      let proceedUrl = ur $ tm $ fbcsR ["login", "back"]+          query' = [(a,b) | (a, Just b) <- query]+      token <- YF.runYesodFbT $ FB.getUserAccessTokenStep2 proceedUrl query'+      setCreds True (createCreds token)      -- Everything else gives 404     dispatch _ _ = notFound@@ -422,10 +421,40 @@ -- | Create an @yesod-auth@'s 'Creds' for a given -- @'FB.UserAccessToken'@. createCreds :: FB.UserAccessToken -> Creds m-createCreds (FB.UserAccessToken (FB.Id userId) _ _) = Creds "fbcs" id_ []-    where id_ = "http://graph.facebook.com/" `mappend` userId+createCreds at@(FB.UserAccessToken (FB.Id userId) _ _) =+  let id_ = "http://graph.facebook.com/" `mappend` userId+  in Creds "fbcs" id_ (atToText at)  +-- | Get the user access token from a 'Creds' created by this+-- backend.  This function should be used on 'getAuthId'.+extractCredsAccessToken :: Creds m -> Maybe FB.UserAccessToken+extractCredsAccessToken (Creds "fbcs" _ extra) = textToAt extra+extractCredsAccessToken _                      = Nothing+++-- | Convert user access token to @[(Text, Text)]@.+--+-- @+-- textToAt . atToText === Just+-- @+atToText :: FB.UserAccessToken -> [(Text, Text)]+atToText (FB.UserAccessToken userId data_ expires) =+  [ ("at_id",      FB.idCode userId)+  , ("at_data",    data_)+  , ("at_expires", T.pack (show expires)) ]+++-- | See 'atToText'.+textToAt :: [(Text, Text)] -> Maybe FB.UserAccessToken+textToAt texts = do+  at_id      <- lookup "at_id"      texts+  at_data    <- lookup "at_data"    texts+  at_expires <- lookup "at_expires" texts+  [(expires, "")] <- return $ readsPrec 0 (T.unpack at_expires)+  return $ FB.UserAccessToken (FB.Id at_id) at_data expires++ -- | Cookie name with the signed request for the given credentials. signedRequestCookieName :: FB.Credentials -> Text signedRequestCookieName = T.append "fbsr_" . FB.appId@@ -438,17 +467,30 @@ -- in).  Note that the returned access token may have expired, we -- recommend using 'FB.hasExpired' and 'FB.isValid'. ----- This 'getUserAccessToken' 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 'getUserAccessToken' 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.-getUserAccessToken :: YesodAuthFbClientSide master =>-                      GHandler sub master (Either String FB.UserAccessToken)-getUserAccessToken =+-- 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'.+getUserAccessTokenFromFbCookie ::+  YesodAuthFbClientSide master =>+  GHandler sub master (Either String FB.UserAccessToken)+getUserAccessTokenFromFbCookie =   runErrorT $ do     creds <- lift YF.getFbCredentials     unparsed <- toErrorT "cookie not found" $ lookupCookie (signedRequestCookieName creds)@@ -473,7 +515,7 @@           _ -> do             -- Get access token from Facebook.             let fbErrorMsg :: FB.FacebookException -> String-                fbErrorMsg exc = "getUserAccessToken: getUserAccessTokenStep2 " +++                fbErrorMsg exc = "getUserAccessTokenFromFbCookie: getUserAccessTokenStep2 " ++                                  "failed with " ++ show exc             token <- ErrorT $                      fmap (either (Left . fbErrorMsg) Right) $@@ -491,12 +533,12 @@       Right (_, Just uid, Just oauth_token, Just expires) ->         return $ FB.UserAccessToken uid oauth_token (toUTCTime expires)       Right (Nothing, _, _, _) ->-        throwError "getUserAccessToken: no user_id nor code on signed request"+        throwError "getUserAccessTokenFromFbCookie: no user_id nor code on signed request"       Left msg ->-        throwError ("getUserAccessToken: never here (" ++ show msg ++ ")")+        throwError ("getUserAccessTokenFromFbCookie: never here (" ++ show msg ++ ")")   where     toErrorT :: Functor m => String -> m (Maybe a) -> ErrorT String m a-    toErrorT msg = ErrorT . fmap (maybe (Left ("getUserAccessToken: " ++ msg)) Right)+    toErrorT msg = ErrorT . fmap (maybe (Left ("getUserAccessTokenFromFbCookie: " ++ msg)) Right)      toUTCTime :: Integer -> TI.UTCTime     toUTCTime = TI.posixSecondsToUTCTime . fromIntegral
yesod-auth-fb.cabal view
@@ -1,5 +1,5 @@ Name:                yesod-auth-fb-Version:             1.4+Version:             1.5 Synopsis:            Authentication backend for Yesod using Facebook. Homepage:            https://github.com/meteficha/yesod-auth-fb License:             BSD3