diff --git a/fb.cabal b/fb.cabal --- a/fb.cabal +++ b/fb.cabal @@ -1,5 +1,5 @@ name: fb -version: 0.9.7 +version: 0.11 license: BSD3 license-file: LICENSE author: Felipe Lessa @@ -52,6 +52,7 @@ Facebook.Auth Facebook.Graph Facebook.Object.User + Facebook.Object.Page Facebook.OpenGraph build-depends: base >= 4 && < 5 @@ -61,11 +62,11 @@ , transformers >= 0.2 && < 0.4 , transformers-base , monad-control - , conduit >= 0.4 && < 0.5 + , conduit >= 0.5 && < 0.6 , http-types - , http-conduit >= 1.4 && < 1.5 + , http-conduit >= 1.5 && < 1.6 , attoparsec >= 0.10 && < 0.11 - , attoparsec-conduit >= 0.4 && < 0.5 + , attoparsec-conduit >= 0.5 && < 0.6 , aeson >= 0.5 && < 0.7 , base64-bytestring >= 0.1.1 && < 0.2 , time >= 1.2 && < 1.5 @@ -102,7 +103,7 @@ -- Test-only dependencies , HUnit , QuickCheck - , hspec >= 0.9.1 && < 1.1 + , hspec >= 0.9.1 && < 1.3 , fb extensions: TypeFamilies diff --git a/src/Facebook.hs b/src/Facebook.hs --- a/src/Facebook.hs +++ b/src/Facebook.hs @@ -39,6 +39,11 @@ , Gender(..) , UserLocation(..) , getUser + , searchUsers + -- ** Page + , Page(..) + , getPage + , searchPages -- * Facebook's Open Graph API -- ** Actions @@ -58,6 +63,8 @@ , postObject , Id(..) , Argument + , searchObjects + , SearchResultPage(..) -- * Exceptions , FacebookException(..) @@ -71,5 +78,6 @@ import Facebook.Base import Facebook.Auth import Facebook.Graph +import Facebook.Object.Page import Facebook.Object.User import Facebook.OpenGraph diff --git a/src/Facebook/Auth.hs b/src/Facebook/Auth.hs --- a/src/Facebook/Auth.hs +++ b/src/Facebook/Auth.hs @@ -62,7 +62,7 @@ tsq creds [("grant_type", "client_credentials")] response <- fbhttp req lift $ - H.responseBody response C.$$ + H.responseBody response C.$$+- C.sinkParser (AppAccessToken <$ A.string "access_token=" <*> A.takeByteString) diff --git a/src/Facebook/Base.hs b/src/Facebook/Base.hs --- a/src/Facebook/Base.hs +++ b/src/Facebook/Base.hs @@ -40,7 +40,7 @@ -- | A plain 'H.Request' to a Facebook API. Use this instead of -- 'H.def' when creating new 'H.Request'@s@ for Facebook. fbreq :: Monad m => - HT.Ascii -- ^ Path. + ByteString -- ^ Path. -> Maybe (AccessToken anyKind) -- ^ Access token. -> HT.SimpleQuery -- ^ Parameters. -> FacebookT anyAuth m (H.Request n) @@ -79,10 +79,10 @@ -- | Converts a plain 'H.Response' coming from 'H.http' into a -- JSON value. asJson :: (C.MonadThrow m, A.FromJSON a) => - H.Response (C.Source m ByteString) + H.Response (C.ResumableSource m ByteString) -> FacebookT anyAuth m a asJson response = do - val <- lift $ H.responseBody response C.$$ C.sinkParser A.json' + val <- lift $ H.responseBody response C.$$+- C.sinkParser A.json' case A.fromJSON val of A.Success r -> return r A.Error str -> @@ -94,9 +94,9 @@ -- | Converts a plain 'H.Response' into a string 'ByteString'. asBS :: (Monad m) => - H.Response (C.Source m ByteString) + H.Response (C.ResumableSource m ByteString) -> FacebookT anyAuth m ByteString -asBS response = lift $ H.responseBody response C.$$ fmap B.concat CL.consume +asBS response = lift $ H.responseBody response C.$$+- fmap B.concat CL.consume -- | An exception that may be thrown by functions on this @@ -123,7 +123,7 @@ -- meaningful 'FacebookException'@s@. fbhttp :: (MonadBaseControl IO m, C.MonadResource m) => H.Request m - -> FacebookT anyAuth m (H.Response (C.Source m ByteString)) + -> FacebookT anyAuth m (H.Response (C.ResumableSource m ByteString)) fbhttp req = do manager <- getManager let req' = req { H.checkStatus = \_ _ -> Nothing } diff --git a/src/Facebook/Graph.hs b/src/Facebook/Graph.hs --- a/src/Facebook/Graph.hs +++ b/src/Facebook/Graph.hs @@ -3,16 +3,17 @@ ( getObject , postObject , Id(..) + , searchObjects + , SearchResultPage(..) ) where import Control.Applicative import Control.Monad.Trans.Control (MonadBaseControl) --- import Control.Monad (mzero) --- import Data.ByteString.Char8 (ByteString) +import Control.Monad (mzero) +import Data.ByteString.Char8 (ByteString) -- import Data.Text (Text) import Data.Typeable (Typeable) -import Network.HTTP.Types (Ascii) -- import qualified Control.Exception.Lifted as E import qualified Data.Aeson as A @@ -30,7 +31,7 @@ -- | Make a raw @GET@ request to Facebook's Graph API. Returns a -- raw JSON 'A.Value'. getObject :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) => - Ascii -- ^ Path (should begin with a slash @\/@) + ByteString -- ^ Path (should begin with a slash @\/@) -> [Argument] -- ^ Arguments to be passed to Facebook -> Maybe (AccessToken anyKind) -- ^ Optional access token -> FacebookT anyAuth m a @@ -42,7 +43,7 @@ -- | Make a raw @POST@ request to Facebook's Graph API. Returns -- a raw JSON 'A.Value'. postObject :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) => - Ascii -- ^ Path (should begin with a slash @\/@) + ByteString -- ^ Path (should begin with a slash @\/@) -> [Argument] -- ^ Arguments to be passed to Facebook -> AccessToken anyKind -- ^ Access token -> FacebookT Auth m a @@ -53,9 +54,50 @@ -- | The identification code of an object. -newtype Id = Id { idCode :: Ascii } +newtype Id = Id { idCode :: ByteString } deriving (Eq, Ord, Show, Read, Typeable) instance A.FromJSON Id where parseJSON (A.Object v) = Id <$> v A..: "id" parseJSON other = Id <$> A.parseJSON other + + +-- | Make a raw @GET@ request to the /search endpoint of Facebook’s +-- Graph API. Returns a raw JSON 'A.Value'. +searchObjects :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) + => ByteString -- ^ A Facebook object type to search for + -> ByteString -- ^ The keyword to search for + -> [Argument] -- ^ Additional arguments to pass + -> Maybe UserAccessToken -- ^ Optional access token + -> FacebookT anyAuth m (SearchResultPage a) +searchObjects objectType keyword query = getObject "/search" query' + where query' = ("q", keyword) : ("type", objectType) : query + + +-- | The result object for searchObjects. The type parameter is +-- expected to be an instance of A.FromJSON, but nothing has been done +-- to assure that Facebook will return the type expected. +data SearchResultPage a = SearchResultPage + { searchResults :: [a] + , searchPage :: Maybe Pager + } deriving (Eq, Ord, Show, Read, Typeable) + +instance (A.FromJSON a) => A.FromJSON (SearchResultPage a) where + parseJSON (A.Object v) = SearchResultPage + <$> v A..: "data" + <*> v A..:? "paging" + parseJSON _ = mzero + + +-- | Simply wraps potential links for previous and next pages within a +-- search result set. TODO: Replace with a type that encapsulates the +-- paging requests instead of just their URLs? +data Pager = Pager { previousPage :: Maybe ByteString + , nextPage :: Maybe ByteString + } deriving (Eq, Ord, Show, Read, Typeable) + +instance A.FromJSON Pager where + parseJSON (A.Object v) = Pager + <$> v A..:? "previous" + <*> v A..:? "next" + parseJSON _ = mzero diff --git a/src/Facebook/Object/Page.hs b/src/Facebook/Object/Page.hs new file mode 100644 --- /dev/null +++ b/src/Facebook/Object/Page.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DeriveDataTypeable + , FlexibleContexts + , OverloadedStrings + #-} +module Facebook.Object.Page + ( Page(..) + , getPage + , searchPages + ) where + +import Control.Applicative +import Control.Monad (mzero) +import Control.Monad.Trans.Control (MonadBaseControl) +import Data.Aeson ((.:), (.:?)) +import Data.ByteString.Char8 (ByteString) +import qualified Data.Aeson as A +import qualified Data.Conduit as C +import Data.Text (Text) +import Data.Typeable (Typeable) + +import Facebook.Graph +import Facebook.Monad +import Facebook.Object.User (UserLocation) +import Facebook.Types + +-- | A Facebook page (see +-- ). +-- +-- /NOTE:/ Does not yet support all fields. Please file an issue if +-- you need any other fields. +data Page = Page { pageId :: ByteString + , pageName :: Maybe Text + , pageLink :: Maybe ByteString + , pageCategory :: Maybe Text + , pageIsPublished :: Maybe Bool + , pageCanPost :: Maybe Bool + , pageLikes :: Maybe Integer + , pageLocation :: Maybe UserLocation + , pagePhone :: Maybe Text + , pageCheckins :: Maybe Integer + , pagePicture :: Maybe ByteString + , pageWebsite :: Maybe ByteString + , pageTalkingAboutCount :: Maybe Integer + } deriving (Eq, Ord, Show, Read, Typeable) + +instance A.FromJSON Page where + parseJSON (A.Object v) = + Page <$> v .: "id" + <*> v .:? "name" + <*> v .:? "link" + <*> v .:? "category" + <*> v .:? "is_published" + <*> v .:? "can_post" + <*> v .:? "likes" + <*> v .:? "location" + <*> v .:? "phone" + <*> v .:? "checkin" + <*> v .:? "picture" + <*> v .:? "website" + <*> v .:? "talking_about_count" + parseJSON _ = mzero + + +-- | Get a page using its ID. The user access token is optional. +getPage :: (C.MonadResource m, MonadBaseControl IO m) + => ByteString -- ^ Page ID + -> [Argument] -- ^ Arguments to be passed to Facebook + -> Maybe UserAccessToken -- ^ Optional user access token + -> FacebookT anyAuth m Page +getPage id_ = getObject $ "/" <> id_ + + +-- | Search pages by keyword. The user access token is optional. +searchPages :: (C.MonadResource m, MonadBaseControl IO m) + => ByteString -- ^ Keyword to search for + -> [Argument] -- ^ Arguments to pass to Facebook + -> Maybe UserAccessToken -- ^ Optional user access token + -> FacebookT anyAuth m (SearchResultPage Page) +searchPages = searchObjects "page" diff --git a/src/Facebook/Object/User.hs b/src/Facebook/Object/User.hs --- a/src/Facebook/Object/User.hs +++ b/src/Facebook/Object/User.hs @@ -4,13 +4,14 @@ , Gender(..) , UserLocation(..) , getUser + , searchUsers ) where import Control.Applicative import Control.Monad (mzero) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson ((.:), (.:?)) --- import Data.ByteString.Char8 (ByteString) +import Data.ByteString.Char8 (ByteString) import Data.Text (Text) import Data.Typeable (Typeable) @@ -103,3 +104,12 @@ -> Maybe UserAccessToken -- ^ Optional user access token. -> FacebookT anyAuth m User getUser id_ query mtoken = getObject ("/" <> id_) query mtoken + + +-- | Search users by keyword. +searchUsers :: (C.MonadResource m, MonadBaseControl IO m) + => ByteString + -> [Argument] + -> Maybe UserAccessToken + -> FacebookT anyAuth m (SearchResultPage User) +searchUsers = searchObjects "user" diff --git a/src/Facebook/OpenGraph.hs b/src/Facebook/OpenGraph.hs --- a/src/Facebook/OpenGraph.hs +++ b/src/Facebook/OpenGraph.hs @@ -13,7 +13,7 @@ import Control.Arrow (first) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad (mzero) --- import Data.ByteString.Char8 (ByteString) +import Data.ByteString.Char8 (ByteString) import Data.Function (on) import Data.List (intersperse) import Data.Text (Text) @@ -23,7 +23,6 @@ import Data.Int (Int8, Int16, Int32) import Data.Word (Word8, Word16, Word32, Word) import Data.String (IsString(..)) -import Network.HTTP.Types (Ascii) import System.Locale (defaultTimeLocale) -- import qualified Control.Exception.Lifted as E @@ -63,7 +62,7 @@ -> FacebookT Auth m Id createAction (Action action) query mapptoken usertoken = do creds <- getCreds - let post :: (C.MonadResource m, MonadBaseControl IO m) => Ascii -> AccessToken anyKind -> FacebookT Auth m Id + let post :: (C.MonadResource m, MonadBaseControl IO m) => ByteString -> AccessToken anyKind -> FacebookT Auth m Id post prepath = postObject (prepath <> appName creds <> ":" <> action) query case mapptoken of Nothing -> post "/me/" usertoken @@ -75,7 +74,7 @@ -- -- to see how you can create actions. -- --- This is a @newtype@ of 'Ascii' that supports only 'IsString'. +-- This is a @newtype@ of 'ByteString' that supports only 'IsString'. -- This means that to create an 'Action' you should use the -- @OverloadedStrings@ language extension. For example, -- @@ -84,7 +83,7 @@ -- > foo token = do -- > ... -- > createAction "cook" [...] token -newtype Action = Action { unAction :: Ascii } +newtype Action = Action { unAction :: ByteString } instance Show Action where show = show . unAction @@ -158,7 +157,7 @@ -- | Create an 'Argument' with a 'SimpleType'. See the docs on -- 'createAction' for an example. -(#=) :: SimpleType a => Ascii -> a -> Argument +(#=) :: SimpleType a => ByteString -> a -> Argument p #= v = (p, encodeFbParam v) diff --git a/src/Facebook/Types.hs b/src/Facebook/Types.hs --- a/src/Facebook/Types.hs +++ b/src/Facebook/Types.hs @@ -19,15 +19,14 @@ import Data.Monoid (Monoid, mappend) import Data.Time (UTCTime) import Data.Typeable (Typeable, Typeable1) -import Network.HTTP.Types (Ascii) -- | Credentials that you get for your app when you register on -- Facebook. data Credentials = - Credentials { appName :: Ascii -- ^ Your application name (e.g. for OpenGraph calls). - , appId :: Ascii -- ^ Your application ID. - , appSecret :: Ascii -- ^ Your application secret key. + Credentials { appName :: ByteString -- ^ Your application name (e.g. for OpenGraph calls). + , appId :: ByteString -- ^ Your application ID. + , appSecret :: ByteString -- ^ Your application secret key. } deriving (Eq, Ord, Show, Read, Typeable) @@ -67,10 +66,10 @@ -- | The access token data that is passed to Facebook's API -- calls. -type AccessTokenData = Ascii +type AccessTokenData = ByteString -- | A Facebook user id such as @1008905713901@. -type UserId = Ascii +type UserId = ByteString -- | Get the access token data. accessTokenData :: AccessToken anyKind -> AccessTokenData diff --git a/tests/runtests.hs b/tests/runtests.hs --- a/tests/runtests.hs +++ b/tests/runtests.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE OverloadedStrings, Rank2Types #-} +{-# LANGUAGE OverloadedStrings + , Rank2Types + , ScopedTypeVariables #-} import Control.Applicative import Control.Monad (mzero) @@ -80,7 +82,7 @@ main :: IO () main = H.withManager $ \manager -> liftIO $ do creds <- getCredentials - hspecX $ do + hspec $ do -- Run the tests twice, once in Facebook's production tier... facebookTests "Production tier: " manager @@ -99,7 +101,7 @@ -> H.Manager -> (forall a. FB.FacebookT FB.Auth (C.ResourceT IO) a -> IO a) -> (forall a. FB.FacebookT FB.NoAuth (C.ResourceT IO) a -> IO a) - -> Specs + -> Spec facebookTests pretitle manager runAuth runNoAuth = do let describe' = describe . (pretitle ++) describe' "getAppAccessToken" $ do @@ -132,7 +134,7 @@ just x = Just (x :: Text) r &?= ( just "19292868552" , just "http://developers.facebook.com" - , just "Facebook Platform" ) + , just "Facebook Developers" ) describe' "getUser" $ do it "works for Zuckerberg" $ do @@ -145,6 +147,20 @@ FB.userLastName user &?= Just "Zuckerberg" FB.userGender user &?= Just FB.Male + describe' "getPage" $ do + it "works for FB Developers" $ do + runNoAuth $ do + page <- FB.getPage "19292868552" [] Nothing + FB.pageId page &?= "19292868552" + FB.pageName page &?= Just "Facebook Developers" + FB.pageCategory page &?= Just "Product/service" + FB.pageIsPublished page &?= Just True + FB.pageCanPost page &?= Nothing + FB.pagePhone page &?= Nothing + FB.pageCheckins page &?= Nothing + FB.pagePicture page &?= Just "http://profile.ak.fbcdn.net/hprofile-ak-ash2/276791_19292868552_1958181823_s.jpg" + FB.pageWebsite page &?= Just "http://developers.facebook.com" + describe' "fqlQuery" $ do it "is able to query Facebook's page name from its page id" $ runNoAuth $ do @@ -157,7 +173,7 @@ parseJSON _ = mzero -libraryTests :: H.Manager -> Specs +libraryTests :: H.Manager -> Spec libraryTests manager = do describe "SimpleType" $ do it "works for Bool" $ (map FB.encodeFbParam [True, False]) @?= ["1", "0"]