packages feed

fb 0.4.0.2 → 0.5

raw patch · 6 files changed

+82/−21 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Facebook: getUserLogoutUrl :: AccessToken User -> RedirectUrl -> Text
- Facebook: UserAccessToken :: AccessTokenData -> UTCTime -> AccessToken User
+ Facebook: UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken User
- Facebook: createAction :: ResourceIO m => Action -> [Argument] -> AccessToken User -> FacebookT Auth m Id
+ Facebook: createAction :: ResourceIO m => Action -> [Argument] -> Maybe (AccessToken App) -> AccessToken User -> FacebookT Auth m Id

Files

fb.cabal view
@@ -1,5 +1,5 @@ name:              fb-version:           0.4.0.2+version:           0.5 license:           BSD3 license-file:      LICENSE author:            Felipe Lessa
src/Facebook.hs view
@@ -23,6 +23,7 @@     , Permission     , getUserAccessTokenStep1     , getUserAccessTokenStep2+    , getUserLogoutUrl     , extendUserAccessToken        -- * Facebook's Open Graph API
src/Facebook/Auth.hs view
@@ -2,6 +2,7 @@     ( getAppAccessToken     , getUserAccessTokenStep1     , getUserAccessTokenStep2+    , getUserLogoutUrl     , extendUserAccessToken     , RedirectUrl     , Permission@@ -11,6 +12,8 @@  import Control.Applicative import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Aeson ((.:))+import Data.Aeson.Types (parseEither) import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Time (getCurrentTime, addUTCTime, UTCTime)@@ -25,7 +28,7 @@ import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE import qualified Network.HTTP.Conduit as H--- import qualified Network.HTTP.Types as HT+import qualified Network.HTTP.Types as HT   import Facebook.Types@@ -83,12 +86,25 @@ getUserAccessTokenStep2 redirectUrl query =   case query of     [code@("code", _)] -> runResourceInFb $ do+      -- Get the access token data through Facebook's OAuth.       now   <- liftIO getCurrentTime       creds <- getCreds       let req = fbreq "/oauth/access_token" Nothing $                 tsq creds [code, ("redirect_uri", TE.encodeUtf8 redirectUrl)]       response <- fbhttp req-      lift $ H.responseBody response C.$$ C.sinkParser (userAccessTokenParser now)+      preToken <- lift $ H.responseBody response C.$$+                         C.sinkParser (userAccessTokenParser now)++      -- Get user's ID throught Facebook's graph.+      userInfo <- asJson =<< fbhttp (fbreq "/me" (Just preToken) [("fields", "id")])+      case (parseEither (.: "id") userInfo, preToken) of+        (Left str, _) ->+            E.throw $ FbLibraryException $ T.concat+                 [ "getUserAccessTokenStep2: failed to get the UserId ("+                 , T.pack str, ")" ]+        (Right (userId :: UserId), UserAccessToken _ d e) ->+            return (UserAccessToken userId d e)+     _ -> let [error_, errorReason, errorDescr] =                  map (fromMaybe "" . flip lookup query)                      ["error", "error_reason", "error_description"]@@ -98,18 +114,43 @@   -- | Attoparsec parser for user access tokens returned by--- Facebook as a query string.-userAccessTokenParser :: UTCTime -- 'getCurrentTime'+-- Facebook as a query string.  Returns an user access token with+-- a broken 'UserId'.+userAccessTokenParser :: UTCTime -- ^ 'getCurrentTime'                       -> A.Parser (AccessToken User) userAccessTokenParser now =-    UserAccessToken <$  A.string "access_token="-                    <*> A.takeWhile (/= '?')-                    <*  A.string "&expires="-                    <*> (toExpire <$> A.decimal)-                    <*  A.endOfInput+    UserAccessToken userId+      <$  A.string "access_token="+      <*> A.takeWhile (/= '?')+      <*  A.string "&expires="+      <*> (toExpire <$> A.decimal)+      <*  A.endOfInput     where toExpire i = addUTCTime (fromIntegral (i :: Int)) now+          userId = error "userAccessTokenParser: never here"  +-- | The URL an user should be redirected to in order to log them+-- out of their Facebook session.  Facebook will then redirect+-- the user to the provided URL after logging them out.  Note+-- that, at the time of this writing, Facebook's policies require+-- you to log the user out of Facebook when they ask to log out+-- of your site.+--+-- Note also that Facebook may refuse to redirect the user to the+-- provided URL if their user access token is invalid.  In order+-- to prevent this bug, we suggest that you use 'isValid' before+-- redirecting the user to the URL provided by 'getUserLogoutUrl'+-- since this function doesn't do any validity checks.+getUserLogoutUrl :: AccessToken User -- ^ The user's access token.+                 -> RedirectUrl      -- ^ URL the user should be directed to in your site domain.+                 -> Text             -- ^ Logout URL in @https:\/\/www.facebook.com\/@.+getUserLogoutUrl (UserAccessToken _ data_ _) next =+    TE.decodeUtf8 $+      "https://www.facebook.com/logout.php?" <>+      HT.renderQuery False [ ("next", Just (TE.encodeUtf8 next))+                           , ("access_token", Just data_) ]++ -- | URL where the user is redirected to after Facebook -- authenticates the user authorizes your application.  This URL -- should be inside the domain registered for your Facebook@@ -161,7 +202,7 @@     then return False     else       let page = case token of-                   UserAccessToken _ _ -> "/me"+                   UserAccessToken _ _ _ -> "/me"                    -- Documented way of checking if the token is valid,                    -- see <https://developers.facebook.com/blog/post/500/>.                    AppAccessToken _ -> "/19292868552"@@ -186,7 +227,7 @@     C.ResourceIO m =>     AccessToken User  -> FacebookT Auth m (Either FacebookException (AccessToken User))-extendUserAccessToken token@(UserAccessToken data_ _)+extendUserAccessToken token@(UserAccessToken _ data_ _)     = do expired <- hasExpired token          if expired then return (Left hasExpiredExc) else tryToExtend     where
src/Facebook/OpenGraph.hs view
@@ -43,11 +43,21 @@ createAction :: C.ResourceIO m =>                 Action     -- ^ Action kind to be created.              -> [Argument] -- ^ Arguments of the action.-             -> AccessToken User+             -> Maybe (AccessToken App)+                -- ^ Optional app access token (optional with+                -- respect to this library, since you can't make+                -- this mandatory by changing the settings of+                -- your action on Facebook).+             -> AccessToken User -- ^ User access token.              -> FacebookT Auth m Id-createAction (Action action) query token = do+createAction (Action action) query mapptoken usertoken = do   creds <- getCreds-  postObject ("/me/" <> appName creds <> ":" <> action) query token+  let post :: C.ResourceIO m => Ascii -> AccessToken anyKind -> FacebookT Auth m Id+      post prepath = postObject (prepath <> appName creds <> ":" <> action) query+  case mapptoken of+    Nothing       -> post "/me/" usertoken+    Just apptoken -> post ("/" <> accessTokenUserId usertoken <> "/") apptoken+   -- | An action of your app.  Please refer to Facebook's
src/Facebook/Types.hs view
@@ -2,8 +2,10 @@     ( Credentials(..)     , AccessToken(..)     , AccessTokenData+    , UserId     , accessTokenData     , accessTokenExpires+    , accessTokenUserId     , User     , App     , Argument@@ -44,7 +46,7 @@ -- These access tokens are distinguished by the phantom type on -- 'AccessToken', which can be 'User' or 'App'. data AccessToken kind where-    UserAccessToken :: AccessTokenData -> UTCTime -> AccessToken User+    UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken User     AppAccessToken  :: AccessTokenData -> AccessToken App  deriving instance Eq   (AccessToken kind)@@ -56,16 +58,23 @@ -- calls. type AccessTokenData = Ascii +-- | A Facebook user id such as @1008905713901@.+type UserId = Ascii+ -- | Get the access token data. accessTokenData :: AccessToken kind -> AccessTokenData-accessTokenData (UserAccessToken d _) = d-accessTokenData (AppAccessToken d)    = d+accessTokenData (UserAccessToken _ d _) = d+accessTokenData (AppAccessToken d)      = d  -- | Expire time of an access token.  It may never expire, in -- which case it will be @Nothing@. accessTokenExpires :: AccessToken kind -> Maybe UTCTime-accessTokenExpires (UserAccessToken _ expt) = Just expt-accessTokenExpires (AppAccessToken _)       = Nothing+accessTokenExpires (UserAccessToken _ _ expt) = Just expt+accessTokenExpires (AppAccessToken _)         = Nothing++-- | Get the user ID of an user access token.+accessTokenUserId :: AccessToken User -> UserId+accessTokenUserId (UserAccessToken uid _ _) = uid  -- | Phantom type used mark an 'AccessToken' as an user access -- token.
tests/runtests.hs view
@@ -63,7 +63,7 @@ invalidCredentials = FB.Credentials "this" "isn't" "valid"  invalidUserAccessToken :: FB.AccessToken FB.User-invalidUserAccessToken = FB.UserAccessToken "invalid" farInTheFuture+invalidUserAccessToken = FB.UserAccessToken "invalid" "user" farInTheFuture     where       Just farInTheFuture = parseTime (error "farInTheFuture") "%Y" "3000"       -- It's actually important to use 'farInTheFuture' since we