yesod-auth-fb 1.5.1 → 1.6

raw patch · 3 files changed

+94/−135 lines, 3 filesdep −old-localedep ~yesod-authdep ~yesod-coredep ~yesod-fbPVP ok

version bump matches the API change (PVP)

Dependencies removed: old-locale

Dependency ranges changed: yesod-auth, yesod-core, yesod-fb

API changes (from Hackage documentation)

Files

• src/Yesod/Auth/Facebook/ClientSide.hs +49/−55
• src/Yesod/Auth/Facebook/ServerSide.hs +41/−75
• yesod-auth-fb.cabal +4/−5

@@ -34,17 +34,14 @@  import Control.Applicative ((<$>), (<*>)) import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Error (ErrorT(..), throwError) import Data.ByteString (ByteString) import Data.Monoid (mappend, mempty) import Data.String (fromString) import Data.Text (Text) import Network.Wai (queryString)-import System.Locale (defaultTimeLocale) import Text.Julius (JavascriptUrl, julius, rawJS) import Yesod.Auth-import Yesod.Content import Yesod.Core import qualified Control.Exception.Lifted as E import qualified Data.Aeson as A@@ -80,18 +77,19 @@ -- anywhere else on the body.  If you absolutely need to do so, -- avoid any elements placed with @position: relative@ or -- @position: absolute@.-facebookJSSDK :: YesodAuthFbClientSide master =>-                 (Route Auth -> Route master)-              -> GWidget sub master ()-facebookJSSDK toMaster = do+facebookJSSDK :: YesodAuthFbClientSide site =>+                 (Route Auth -> Route site)+              -> WidgetT site IO ()+facebookJSSDK toSite = do   (lang, fbInitOptsList, muid, ur) <--    lift $ (,,,) <$> getFbLanguage-                 <*> getFbInitOpts-                 <*> maybeAuthId-                 <*> getUrlRender+    handlerToWidget $+      (,,,) <$> getFbLanguage+            <*> getFbInitOpts+            <*> maybeAuthId+            <*> getUrlRender   let loggedIn = maybe False (const True) muid-      loginRoute  = toMaster $ fbcsR ["login"]-      logoutRoute = toMaster $ LogoutR+      loginRoute  = toSite $ fbcsR ["login"]+      logoutRoute = toSite $ LogoutR       fbInitOpts  = A.object $ map (uncurry (A..=)) fbInitOptsList   [whamlet|$newline never     <div #fb-root>@@ -143,7 +141,7 @@       FB.getLoginStatus(function(response) {         if (response.status !== 'connected' ||             FB.logout(function () {}) === undefined) {-          window.location.href = #{A.toJSON (ur (toMaster LogoutR))}+          window.location.href = #{A.toJSON (ur (toSite LogoutR))}         }       });       return (function () {});@@ -225,7 +223,7 @@ -- -- Minimal complete definition: 'getFbChannelFile'.  (We -- recommend implementing 'getFbLanguage' as well.)-class (YesodAuth master, YF.YesodFacebook master) => YesodAuthFbClientSide master where+class (YesodAuth site, YF.YesodFacebook site) => YesodAuthFbClientSide site where   -- | A route that serves Facebook's channel file in the /same/   -- /subdomain/ as the current request's subdomain.   --@@ -234,7 +232,7 @@   -- is 'ChannelFileR', then you just need:   --   -- @-  --   getChannelFileR :: GHandler sub master ChooseRep+  --   getChannelFileR :: HandlerT site IO ChooseRep   --   getChannelFileR = serveChannelFile   -- @   --@@ -249,8 +247,8 @@   -- 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 'GHandler'.-  getFbChannelFile :: GHandler sub master (Route master)+  -- lives inside 'HandlerT'.+  getFbChannelFile :: HandlerT site IO (Route site)                       -- ^ Return channel file in the /same/                       -- /subdomain/ as the current route. @@ -283,7 +281,7 @@   -- /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).-  getFbLanguage :: GHandler sub master Text+  getFbLanguage :: HandlerT site IO Text   getFbLanguage = return "en_US"    -- | /(Optional)/ Options that should be given to @FB.init()@.@@ -300,13 +298,13 @@   --   -- However, if you know what you're doing you're free to   -- override any or all values returned by 'defaultFbInitOpts'.-  getFbInitOpts :: GHandler sub master [(Text, A.Value)]+  getFbInitOpts :: HandlerT site IO [(Text, A.Value)]   getFbInitOpts = defaultFbInitOpts    -- | /(Optional)/ Arbitrary JavaScript that will be called on   -- Facebook's JS SDK's @fbAsyncInit@ (i.e. as soon as their SDK   -- is loaded).-  fbAsyncInitJs :: JavascriptUrl (Route master)+  fbAsyncInitJs :: JavascriptUrl (Route site)   fbAsyncInitJs = const mempty  @@ -320,8 +318,8 @@ --  this module won't work /at all/ without it. -- --  [@status@] To @True@, since this usually is what you want.-defaultFbInitOpts :: YesodAuthFbClientSide master =>-                     GHandler sub master [(Text, A.Value)]+defaultFbInitOpts :: YesodAuthFbClientSide site =>+                     HandlerT site IO [(Text, A.Value)] defaultFbInitOpts = do   ur <- getUrlRender   creds <- YF.getFbCredentials@@ -339,18 +337,13 @@ -- 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.-serveChannelFile :: GHandler sub master ChooseRep+serveChannelFile :: HandlerT site IO TypedContent serveChannelFile = do-  now <- liftIO TI.getCurrentTime-  setHeader "Pragma" "public"-  setHeader "Cache-Control" maxAge-  setHeader "Expires" (T.pack $ expires now)-  return $ chooseRep ("text/html" :: ContentType, channelFileContent)+  addHeader "Pragma" "public"+  cacheSeconds oneYearSecs+  neverExpires+  selectRep $ provideRepType "text/html" (return channelFileContent)  where oneYearSecs = 60*60*24*365 :: Int-       oneYearNDF  = fromIntegral oneYearSecs :: TI.NominalDiffTime-       maxAge      = "max-age=" `T.append` T.pack (show oneYearSecs)-       expires now = TI.formatTime defaultTimeLocale "%a, %d %b %Y %T GMT" $-                     TI.addUTCTime oneYearNDF now   -- | Channel file's content.  On the toplevel in order to have@@ -365,37 +358,37 @@ -- authentication flow. -- -- You /MUST/ use 'facebookJSSDK' as its documentation states.-authFacebookClientSide :: YesodAuthFbClientSide master-                       => AuthPlugin master+authFacebookClientSide :: YesodAuthFbClientSide site+                       => AuthPlugin site authFacebookClientSide =     AuthPlugin "fbcs" dispatch login   where-    dispatch :: YesodAuthFbClientSide master =>-                Text -> [Text] -> GHandler Auth master ()+    dispatch :: YesodAuthFbClientSide site =>+                Text -> [Text] -> HandlerT Auth (HandlerT site IO) ()     -- Login route used when successfully logging in.  Called via     -- AJAX by JavaScript code on 'facebookJSSDK'.     dispatch "GET" ["login"] = do-      y <- getYesod-      when (redirectToReferer y) setUltDestReferer-      etoken <- getUserAccessTokenFromFbCookie+      y <- lift getYesod+      when (redirectToReferer y) (lift setUltDestReferer)+      etoken <- lift getUserAccessTokenFromFbCookie       case etoken of-        Right token -> setCreds True (createCreds token)+        Right token -> lift $ setCreds True (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  <- getYesod+      y  <- lift getYesod       ur <- getUrlRender-      tm <- getRouteToMaster-      when (redirectToReferer y) setUltDestReferer-      let redirectTo = ur $ tm $ fbcsR ["login", "back"]+      when (redirectToReferer y) (lift setUltDestReferer)+      let redirectTo = ur $ fbcsR ["login", "back"]           uncommas "" = []           uncommas xs = case break (== ',') xs of                           (x', ',':xs') -> x' : uncommas xs'                           (x', _)       -> [x']-      url <- YF.runYesodFbT $+      url <- lift $+             YF.runYesodFbT $              FB.getUserAccessTokenStep1 redirectTo $                map fromString $ uncommas $ T.unpack perms       redirect url@@ -407,20 +400,21 @@       -- flimsy and sometimes the user landed on a blank page due       -- to race conditions.       ur <- getUrlRender-      tm <- getRouteToMaster       query <- queryString <$> waiRequest-      let proceedUrl = ur $ tm $ fbcsR ["login", "back"]+      let proceedUrl = ur $ fbcsR ["login", "back"]           query' = [(a,b) | (a, Just b) <- query]-      token <- YF.runYesodFbT $ FB.getUserAccessTokenStep2 proceedUrl query'-      setCreds True (createCreds token)+      token <- lift $+               YF.runYesodFbT $+               FB.getUserAccessTokenStep2 proceedUrl query'+      lift $ setCreds True (createCreds token)      -- Everything else gives 404     dispatch _ _ = notFound      -- Small widget for multiple login websites.-    login :: YesodAuth master =>-             (Route Auth -> Route master)-          -> GWidget sub master ()+    login :: YesodAuth site =>+             (Route Auth -> Route site)+          -> WidgetT site IO ()     login _ = [whamlet|$newline never                  <p>                    <a href="#" onclick="#{facebookLogin perms}">@@ -499,8 +493,8 @@ -- not use this function on 'getAuthId'.  Instead, you should use -- 'extractCredsAccessToken'. getUserAccessTokenFromFbCookie ::-  YesodAuthFbClientSide master =>-  GHandler sub master (Either String FB.UserAccessToken)+  YesodAuthFbClientSide site =>+  HandlerT site IO (Either String FB.UserAccessToken) getUserAccessTokenFromFbCookie =   runErrorT $ do     creds <- lift YF.getFbCredentials

@@ -11,24 +11,21 @@     , setUserAccessToken        -- * Advanced-    , beta_authFacebook     , deleteUserAccessToken     ) where  import Control.Applicative ((<$>)) import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO, liftIO) 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 Yesod.Core import qualified Data.Text as T import qualified Facebook as FB import qualified Yesod.Auth.Message as Msg-import qualified Data.Conduit as C+import qualified Yesod.Facebook as YF  -- | Route for login using this authentication plugin. facebookLogin :: AuthRoute@@ -47,84 +44,51 @@   -- | Yesod authentication plugin using Facebook.-authFacebook :: YesodAuth master-             => FB.Credentials  -- ^ Your application's credentials.-             -> [FB.Permission] -- ^ Permissions to be requested.-             -> AuthPlugin master-authFacebook = authFacebookHelper False----- | Same as 'authFacebook', but uses Facebook's beta tier.--- Usually this is /not/ what you want, so use 'authFacebook'--- unless you know what you're doing.------ /Since: 0.10.1/-beta_authFacebook :: YesodAuth master-                  => FB.Credentials-                  -> [FB.Permission]-                  -> AuthPlugin master-beta_authFacebook = authFacebookHelper True----- | Helper function for 'authFacebook' and 'beta_authFacebook'.-authFacebookHelper :: YesodAuth master-                   => Bool -- ^ @useBeta@-                   -> FB.Credentials-                   -> [FB.Permission]-                   -> AuthPlugin master-authFacebookHelper useBeta creds perms = AuthPlugin "fb" dispatch login+authFacebook :: (YesodAuth site, YF.YesodFacebook site)+             => [FB.Permission] -- ^ Permissions to be requested.+             -> AuthPlugin site+authFacebook perms = AuthPlugin "fb" dispatch login   where-    -- Run a Facebook action.-    runFB :: YesodAuth master =>-             FB.FacebookT FB.Auth (C.ResourceT IO) a-          -> GHandler sub master a-    runFB act = do-      manager <- authHttpManager <$> getYesod-      liftIO $ C.runResourceT $-        (if useBeta then FB.beta_runFacebookT else FB.runFacebookT)-        creds manager act-     -- Get the URL in facebook.com where users are redirected to.-    getRedirectUrl :: YesodAuth master =>-                      (Route Auth -> Route master)-                   -> GHandler sub master Text-    getRedirectUrl tm = do-        render  <- getUrlRender-        let proceedUrl = render (tm proceedR)-        runFB $ FB.getUserAccessTokenStep1 proceedUrl perms+    getRedirectUrl :: YF.YesodFacebook site => (Route Auth -> Text) -> HandlerT site IO Text+    getRedirectUrl render =+        YF.runYesodFbT $ FB.getUserAccessTokenStep1 (render proceedR) perms     proceedR = PluginR "fb" ["proceed"] +    dispatch :: (YesodAuth site, YF.YesodFacebook site) =>+                Text -> [Text] -> HandlerT Auth (HandlerT site IO) ()     -- Redirect the user to Facebook.     dispatch "GET" ["login"] = do-        m <- getYesod-        when (redirectToReferer m) setUltDestReferer-        redirect =<< getRedirectUrl =<< getRouteToMaster+        ur <- getUrlRender+        lift $ do+          y <- getYesod+          when (redirectToReferer y) setUltDestReferer+          redirect =<< getRedirectUrl ur     -- Take Facebook's code and finish authentication.     dispatch "GET" ["proceed"] = do-        tm     <- getRouteToMaster         render <- getUrlRender         query  <- queryString <$> waiRequest-        let proceedUrl = render (tm proceedR)+        let proceedUrl = render proceedR             query' = [(a,b) | (a, Just b) <- query]-        token <- runFB $ FB.getUserAccessTokenStep2 proceedUrl query'-        setUserAccessToken token-        setCreds True (createCreds token)+        lift $ do+          token <- YF.runYesodFbT $ 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+        y      <- lift getYesod+        mtoken <- lift getUserAccessToken+        when (redirectToReferer y) (lift 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) (runFB . FB.isValid) mtoken+        valid <- maybe (return False) (lift . YF.runYesodFbT . FB.isValid) mtoken          case (valid, mtoken) of           (True, Just token) -> do             render <- getUrlRender-            dest <- runFB $ FB.getUserLogoutUrl token (render $ tm $ PluginR "fb" ["kthxbye"])+            dest <- lift $ YF.runYesodFbT $ FB.getUserLogoutUrl token (render $ PluginR "fb" ["kthxbye"])             redirect dest           _ -> dispatch "GET" ["kthxbye"]     -- Finish the logout procedure.  Unfortunately we have to@@ -132,21 +96,23 @@     -- not accessible for us.  We also can't just redirect to     -- LogoutR since it would otherwise call setUltDestReferrer     -- again.-    dispatch "GET" ["kthxbye"] = do-        m <- getYesod-        deleteSession "_ID"-        deleteUserAccessToken-        onLogout-        redirectUltDest $ logoutDest m+    dispatch "GET" ["kthxbye"] =+        lift $ do+          m <- getYesod+          deleteSession "_ID"+          deleteUserAccessToken+          onLogout+          redirectUltDest $ logoutDest m     -- Anything else gives 404     dispatch _ _ = notFound      -- Small widget for multiple login websites.-    login :: YesodAuth master =>-             (Route Auth -> Route master)-          -> GWidget sub master ()+    login :: (YesodAuth site, YF.YesodFacebook site) =>+             (Route Auth -> Route site)+          -> WidgetT site IO ()     login tm = do-        redirectUrl <- lift (getRedirectUrl tm)+        ur <- getUrlRender+        redirectUrl <- handlerToWidget $ getRedirectUrl (ur . tm)         [whamlet|$newline never <p>     <a href="#{redirectUrl}">_{Msg.Facebook}@@ -164,7 +130,7 @@ -- Usually you don't need to call this function, but it may -- become handy together with 'FB.extendUserAccessToken'. setUserAccessToken :: FB.UserAccessToken-                   -> GHandler sub master ()+                   -> HandlerT site IO () setUserAccessToken (FB.UserAccessToken (FB.Id userId) data_ exptime) = do   setSession "_FBID" userId   setSession "_FBAT" data_@@ -176,7 +142,7 @@ -- 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 :: GHandler sub master (Maybe FB.UserAccessToken)+getUserAccessToken :: HandlerT site IO (Maybe FB.UserAccessToken) getUserAccessToken = runMaybeT $ do   userId  <- MaybeT $ lookupSession "_FBID"   data_   <- MaybeT $ lookupSession "_FBAT"@@ -186,7 +152,7 @@  -- | Delete Facebook's user access token from the session.  /Do/ -- /not use/ this function unless you know what you're doing.-deleteUserAccessToken :: GHandler sub master ()+deleteUserAccessToken :: HandlerT site IO () deleteUserAccessToken = do   deleteSession "_FBID"   deleteSession "_FBAT"

@@ -1,5 +1,5 @@ Name:                yesod-auth-fb-Version:             1.5.1+Version:             1.6 Synopsis:            Authentication backend for Yesod using Facebook. Homepage:            https://github.com/meteficha/yesod-auth-fb License:             BSD3@@ -42,21 +42,20 @@    Build-depends:   base         >= 4.3     && < 5                  , lifted-base  >= 0.1     && < 0.3-                 , yesod-core   == 1.1.*-                 , yesod-auth   == 1.1.*+                 , yesod-core   == 1.2.*+                 , yesod-auth   == 1.2.*                  , hamlet                  , shakespeare-js >= 1.0.2                  , wai                  , http-conduit >= 1.9                  , text         >= 0.7     && < 0.12                  , transformers >= 0.1.3   && < 0.4-                 , yesod-fb     == 0.2.*+                 , yesod-fb     == 0.3.*                  , fb           == 0.14.*                  , conduit      == 1.0.*                  , bytestring   >= 0.9     && < 0.11                  , aeson        == 0.6.*                  , time         >= 1.0     && < 1.5-                 , old-locale   == 1.0.*    Exposed-modules: Yesod.Auth.Facebook                  , Yesod.Auth.Facebook.ClientSide