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 +2/−1
- src/Facebook.hs +11/−2
- src/Facebook/Auth.hs +8/−8
- src/Facebook/Base.hs +2/−2
- src/Facebook/Graph.hs +4/−4
- src/Facebook/Object/User.hs +86/−0
- src/Facebook/OpenGraph.hs +2/−2
- src/Facebook/Types.hs +21/−11
- tests/runtests.hs +13/−2
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