packages feed

fb 0.5 → 0.6

raw patch · 9 files changed

+149/−32 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Facebook: data App
+ Facebook: Female :: Gender
+ Facebook: Male :: Gender
+ Facebook: User :: UserId -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Gender -> Maybe Text -> Maybe Text -> Maybe Bool -> Maybe Text -> User
+ Facebook: data AppKind
+ Facebook: data Gender
+ Facebook: data UserKind
+ Facebook: getUser :: ResourceIO m => UserId -> [Argument] -> Maybe UserAccessToken -> FacebookT anyAuth m User
+ Facebook: type AppAccessToken = AccessToken AppKind
+ Facebook: type UserAccessToken = AccessToken UserKind
+ Facebook: userEmail :: User -> Maybe Text
+ Facebook: userFirstName :: User -> Maybe Text
+ Facebook: userGender :: User -> Maybe Gender
+ Facebook: userId :: User -> UserId
+ Facebook: userLastName :: User -> Maybe Text
+ Facebook: userLocale :: User -> Maybe Text
+ Facebook: userMiddleName :: User -> Maybe Text
+ Facebook: userName :: User -> Maybe Text
+ Facebook: userUsername :: User -> Maybe Text
+ Facebook: userVerified :: User -> Maybe Bool
- Facebook: AppAccessToken :: AccessTokenData -> AccessToken App
+ Facebook: AppAccessToken :: AccessTokenData -> AccessToken AppKind
- Facebook: UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken User
+ Facebook: UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken UserKind
- Facebook: createAction :: ResourceIO m => Action -> [Argument] -> Maybe (AccessToken App) -> AccessToken User -> FacebookT Auth m Id
+ Facebook: createAction :: ResourceIO m => Action -> [Argument] -> Maybe AppAccessToken -> UserAccessToken -> FacebookT Auth m Id
- Facebook: extendUserAccessToken :: ResourceIO m => AccessToken User -> FacebookT Auth m (Either FacebookException (AccessToken User))
+ Facebook: extendUserAccessToken :: ResourceIO m => UserAccessToken -> FacebookT Auth m (Either FacebookException UserAccessToken)
- Facebook: getAppAccessToken :: ResourceIO m => FacebookT Auth m (AccessToken App)
+ Facebook: getAppAccessToken :: ResourceIO m => FacebookT Auth m AppAccessToken
- Facebook: getObject :: (ResourceIO m, FromJSON a) => Ascii -> [Argument] -> Maybe (AccessToken kind) -> FacebookT anyAuth m a
+ Facebook: getObject :: (ResourceIO m, FromJSON a) => Ascii -> [Argument] -> Maybe (AccessToken anyKind) -> FacebookT anyAuth m a
- Facebook: getUserAccessTokenStep2 :: ResourceIO m => RedirectUrl -> [Argument] -> FacebookT Auth m (AccessToken User)
+ Facebook: getUserAccessTokenStep2 :: ResourceIO m => RedirectUrl -> [Argument] -> FacebookT Auth m UserAccessToken
- Facebook: getUserLogoutUrl :: AccessToken User -> RedirectUrl -> Text
+ Facebook: getUserLogoutUrl :: UserAccessToken -> RedirectUrl -> Text
- Facebook: hasExpired :: (Functor m, MonadIO m) => AccessToken kind -> m Bool
+ Facebook: hasExpired :: (Functor m, MonadIO m) => AccessToken anyKind -> m Bool
- Facebook: isValid :: ResourceIO m => AccessToken kind -> FacebookT anyAuth m Bool
+ Facebook: isValid :: ResourceIO m => AccessToken anyKind -> FacebookT anyAuth m Bool
- Facebook: postObject :: (ResourceIO m, FromJSON a) => Ascii -> [Argument] -> AccessToken kind -> FacebookT Auth m a
+ Facebook: postObject :: (ResourceIO m, FromJSON a) => Ascii -> [Argument] -> AccessToken anyKind -> FacebookT Auth m a

Files

fb.cabal view
@@ -1,5 +1,5 @@ name:              fb-version:           0.5+version:           0.6 license:           BSD3 license-file:      LICENSE author:            Felipe Lessa@@ -45,6 +45,7 @@     Facebook.Base     Facebook.Auth     Facebook.Graph+    Facebook.Object.User     Facebook.OpenGraph   build-depends:       base               >= 4       && < 5
src/Facebook.hs view
@@ -11,14 +11,16 @@     , Credentials(..)       -- ** Access token     , AccessToken(..)+    , UserAccessToken+    , AppAccessToken     , AccessTokenData     , hasExpired     , isValid       -- ** App access token-    , App+    , AppKind     , getAppAccessToken       -- ** User access token-    , User+    , UserKind     , RedirectUrl     , Permission     , getUserAccessTokenStep1@@ -26,6 +28,12 @@     , getUserLogoutUrl     , extendUserAccessToken +      -- * Facebook's Graph API Objects+      -- ** User+    , User(..)+    , Gender(..)+    , getUser+       -- * Facebook's Open Graph API     , createAction     , Action@@ -47,4 +55,5 @@ import Facebook.Base import Facebook.Auth import Facebook.Graph+import Facebook.Object.User import Facebook.OpenGraph
src/Facebook/Auth.hs view
@@ -39,7 +39,7 @@ -- | Get an app access token from Facebook using your -- credentials. getAppAccessToken :: C.ResourceIO m =>-                     FacebookT Auth m (AccessToken App)+                     FacebookT Auth m AppAccessToken getAppAccessToken =   runResourceInFb $ do     creds <- getCreds@@ -82,7 +82,7 @@                            RedirectUrl -- ^ Should be exactly the same                                        -- as in 'getUserAccessTokenStep1'.                         -> [Argument]-                        -> FacebookT Auth m (AccessToken User)+                        -> FacebookT Auth m UserAccessToken getUserAccessTokenStep2 redirectUrl query =   case query of     [code@("code", _)] -> runResourceInFb $ do@@ -117,7 +117,7 @@ -- Facebook as a query string.  Returns an user access token with -- a broken 'UserId'. userAccessTokenParser :: UTCTime -- ^ 'getCurrentTime'-                      -> A.Parser (AccessToken User)+                      -> A.Parser UserAccessToken userAccessTokenParser now =     UserAccessToken userId       <$  A.string "access_token="@@ -141,7 +141,7 @@ -- 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.+getUserLogoutUrl :: UserAccessToken  -- ^ 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 =@@ -181,7 +181,7 @@   -- | @True@ if the access token has expired, otherwise @False@.-hasExpired :: (Functor m, MonadIO m) => AccessToken kind -> m Bool+hasExpired :: (Functor m, MonadIO m) => AccessToken anyKind -> m Bool hasExpired token =   case accessTokenExpires token of     Nothing      -> return False@@ -194,7 +194,7 @@ -- case of an user access token, they may have changed their -- password, logged out from Facebook or blocked your app. isValid :: C.ResourceIO m =>-           AccessToken kind+           AccessToken anyKind         -> FacebookT anyAuth m Bool isValid token = do   expired <- hasExpired token@@ -225,8 +225,8 @@ -- extended, only valid tokens. extendUserAccessToken ::     C.ResourceIO m =>-    AccessToken User- -> FacebookT Auth m (Either FacebookException (AccessToken User))+    UserAccessToken+ -> FacebookT Auth m (Either FacebookException UserAccessToken) extendUserAccessToken token@(UserAccessToken _ data_ _)     = do expired <- hasExpired token          if expired then return (Left hasExpiredExc) else tryToExtend
src/Facebook/Base.hs view
@@ -29,7 +29,7 @@  -- | A plain 'H.Request' to a Facebook API.  Use this instead of -- 'H.def' when creating new 'H.Request'@s@ for Facebook.-fbreq :: HT.Ascii -> Maybe (AccessToken kind) -> HT.SimpleQuery -> H.Request m+fbreq :: HT.Ascii -> Maybe (AccessToken anyKind) -> HT.SimpleQuery -> H.Request m fbreq path mtoken query =     H.def { H.secure        = True           , H.host          = "graph.facebook.com"@@ -54,7 +54,7 @@     tsq creds = (:) ("client_id",     appId     creds) .                 (:) ("client_secret", appSecret creds) -instance ToSimpleQuery (AccessToken kind) where+instance ToSimpleQuery (AccessToken anyKind) where     tsq token = (:) ("access_token", accessTokenData token)  
src/Facebook/Graph.hs view
@@ -30,7 +30,7 @@ getObject :: (C.ResourceIO m, A.FromJSON a) =>              Ascii          -- ^ Path (should begin with a slash @\/@)           -> [Argument]     -- ^ Arguments to be passed to Facebook-          -> Maybe (AccessToken kind) -- ^ Optional access token+          -> Maybe (AccessToken anyKind) -- ^ Optional access token           -> FacebookT anyAuth m a getObject path query mtoken =   runResourceInFb $@@ -40,9 +40,9 @@ -- | Make a raw @POST@ request to Facebook's Graph API.  Returns -- a raw JSON 'A.Value'. postObject :: (C.ResourceIO m, A.FromJSON a) =>-              Ascii            -- ^ Path (should begin with a slash @\/@)-           -> [Argument]       -- ^ Arguments to be passed to Facebook-           -> AccessToken kind -- ^ Access token+              Ascii               -- ^ Path (should begin with a slash @\/@)+           -> [Argument]          -- ^ Arguments to be passed to Facebook+           -> AccessToken anyKind -- ^ Access token            -> FacebookT Auth m a postObject path query token =   runResourceInFb $
+ src/Facebook/Object/User.hs view
@@ -0,0 +1,86 @@+module Facebook.Object.User+    ( User(..)+    , Gender(..)+    , getUser+    ) where++import Control.Applicative+import Control.Monad (mzero)+import Data.Aeson ((.:), (.:?))+-- import Data.ByteString.Char8 (ByteString)+import Data.Text (Text)+import Data.Typeable (Typeable)++-- import qualified Control.Exception.Lifted as E+import qualified Data.Aeson as A+import qualified Data.Conduit as C+-- import qualified Data.Text as T+++import Facebook.Types+import Facebook.Monad+import Facebook.Graph+++-- | A Facebook user profile (see+-- <https://developers.facebook.com/docs/reference/api/user/>).+--+-- /NOTE:/ We still don't support all fields supported by+-- Facebook. Please fill an issue if you need access to any other+-- fields.+data User =+    User { userId         :: UserId+         , userName       :: Maybe Text+         , userFirstName  :: Maybe Text+         , userMiddleName :: Maybe Text+         , userLastName   :: Maybe Text+         , userGender     :: Maybe Gender+         , userLocale     :: Maybe Text+         , userUsername   :: Maybe Text+         , userVerified   :: Maybe Bool+         , userEmail      :: Maybe Text+         }+    deriving (Eq, Ord, Show, Typeable)++instance A.FromJSON User where+    parseJSON (A.Object v) =+      User <$> v .:  "id"+           <*> v .:? "name"+           <*> v .:? "first_name"+           <*> v .:? "middle_name"+           <*> v .:? "last_name"+           <*> v .:? "gender"+           <*> v .:? "locale"+           <*> v .:? "username"+           <*> v .:? "verified"+           <*> v .:? "email"+    parseJSON _ = mzero+++-- | An user's gender.+data Gender = Male | Female deriving (Eq, Ord, Show, Enum, Typeable)++instance A.FromJSON Gender where+    parseJSON (A.String "male")   = return Male+    parseJSON (A.String "female") = return Female+    parseJSON _                   = mzero++instance A.ToJSON Gender where+    toJSON = A.toJSON . toText+        where+          toText :: Gender -> Text+          toText Male   = "male"+          toText Female = "female"+++-- | Get an user using his user ID.  The user access token is+-- optional, but when provided more information can be returned+-- back by Facebook.  The user ID may be @\"me\"@, in which+-- case you must provide an user access token and information+-- about the token's owner is given.+getUser :: C.ResourceIO m =>+           UserId         -- ^ User ID or @\"me\"@.+        -> [Argument]     -- ^ Arguments to be passed to Facebook.+        -> Maybe UserAccessToken -- ^ Optional user access token.+        -> FacebookT anyAuth m User+getUser id_ query mtoken = getObject ("/" <> id_) query mtoken
src/Facebook/OpenGraph.hs view
@@ -43,12 +43,12 @@ createAction :: C.ResourceIO m =>                 Action     -- ^ Action kind to be created.              -> [Argument] -- ^ Arguments of the action.-             -> Maybe (AccessToken App)+             -> Maybe AppAccessToken                 -- ^ 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.+             -> UserAccessToken -- ^ Required user access token.              -> FacebookT Auth m Id createAction (Action action) query mapptoken usertoken = do   creds <- getCreds
src/Facebook/Types.hs view
@@ -1,13 +1,15 @@ module Facebook.Types     ( Credentials(..)     , AccessToken(..)+    , UserAccessToken+    , AppAccessToken     , AccessTokenData     , UserId     , accessTokenData     , accessTokenExpires     , accessTokenUserId-    , User-    , App+    , UserKind+    , AppKind     , Argument     , (<>)     ) where@@ -43,12 +45,20 @@ -- [App access token] An access token that allows you to take -- administrative actions for your application. ----- These access tokens are distinguished by the phantom type on--- 'AccessToken', which can be 'User' or 'App'.+-- These two kinds of access tokens are distinguished by the+-- phantom type on 'AccessToken', which can be 'UserKind' or+-- 'AppKind'. data AccessToken kind where-    UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken User-    AppAccessToken  :: AccessTokenData -> AccessToken App+    UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken UserKind+    AppAccessToken  :: AccessTokenData -> AccessToken AppKind +-- | Type synonym for @'AccessToken' 'UserKind'@+type UserAccessToken = AccessToken UserKind++-- | Type synonym for @'AccessToken' 'AppKind'@+type AppAccessToken = AccessToken AppKind++ deriving instance Eq   (AccessToken kind) deriving instance Ord  (AccessToken kind) deriving instance Show (AccessToken kind)@@ -62,27 +72,27 @@ type UserId = Ascii  -- | Get the access token data.-accessTokenData :: AccessToken kind -> AccessTokenData+accessTokenData :: AccessToken anyKind -> AccessTokenData 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 :: AccessToken anyKind -> Maybe UTCTime accessTokenExpires (UserAccessToken _ _ expt) = Just expt accessTokenExpires (AppAccessToken _)         = Nothing  -- | Get the user ID of an user access token.-accessTokenUserId :: AccessToken User -> UserId+accessTokenUserId :: UserAccessToken -> UserId accessTokenUserId (UserAccessToken uid _ _) = uid  -- | Phantom type used mark an 'AccessToken' as an user access -- token.-data User deriving (Typeable)+data UserKind deriving (Typeable)  -- | Phantom type used mark an 'AccessToken' as an app access -- token.-data App deriving (Typeable)+data AppKind deriving (Typeable)   -- | An argument given to an API call.
tests/runtests.hs view
@@ -62,7 +62,7 @@ invalidCredentials :: FB.Credentials invalidCredentials = FB.Credentials "this" "isn't" "valid" -invalidUserAccessToken :: FB.AccessToken FB.User+invalidUserAccessToken :: FB.UserAccessToken invalidUserAccessToken = FB.UserAccessToken "invalid" "user" farInTheFuture     where       Just farInTheFuture = parseTime (error "farInTheFuture") "%Y" "3000"@@ -70,7 +70,7 @@       -- don't want any tests rejecting this invalid user access       -- token before even giving it to Facebook. -invalidAppAccessToken :: FB.AccessToken FB.App+invalidAppAccessToken :: FB.AppAccessToken invalidAppAccessToken = FB.AppAccessToken "invalid"  @@ -140,6 +140,17 @@       prop "works for Word32" (propShowRead :: Word32 -> Bool)        prop "works for Text" (\t -> FB.encodeFbParam t == t)++    describe "getUser" $ do+      it "works for Zuckerberg" $ do+        runNoAuth $ do+          user <- FB.getUser "zuck" [] Nothing+          FB.userId user         &?= "4"+          FB.userName user       &?= Just "Mark Zuckerberg"+          FB.userFirstName user  &?= Just "Mark"+          FB.userMiddleName user &?= Nothing+          FB.userLastName user   &?= Just "Zuckerberg"+          FB.userGender user     &?= Just FB.Male   -- Wrappers for HUnit operators using MonadIO