diff --git a/fb.cabal b/fb.cabal --- a/fb.cabal +++ b/fb.cabal @@ -1,5 +1,5 @@ name: fb -version: 0.2 +version: 0.2.1 license: BSD3 license-file: LICENSE author: Felipe Lessa @@ -39,18 +39,20 @@ ghc-options: -Wall exposed-modules: Facebook + Facebook.OpenGraph other-modules: Facebook.Base Facebook.Auth + Facebook.OpenGraph.Base build-depends: base >= 4 && < 5 , lifted-base >= 0.1 && < 0.2 , bytestring >= 0.9 && < 0.10 , text >= 0.11 && < 0.12 , transformers >= 0.2 && < 0.3 - , conduit >= 0.0 && < 0.2 + , conduit >= 0.1.1.1 && < 0.2 , http-types - , http-conduit >= 1.1.2.2 && < 1.2 + , http-conduit >= 1.2 && < 1.3 , attoparsec >= 0.10 && < 0.11 , attoparsec-conduit >= 0.0 && < 0.1 , aeson >= 0.5 && < 0.6 @@ -73,7 +75,7 @@ -- Library dependencies used on the tests. No need to -- specify versions since they'll use the same as above. base, lifted-base, transformers, bytestring, conduit, - http-conduit, time + http-conduit, text, time, aeson -- Test-only dependencies , HUnit diff --git a/src/Facebook/Base.hs b/src/Facebook/Base.hs --- a/src/Facebook/Base.hs +++ b/src/Facebook/Base.hs @@ -124,18 +124,22 @@ -- | Converts a plain 'H.Response' coming from 'H.http' into a -- response with a JSON value. -asJson :: (C.ResourceThrow m, C.BufferSource bsrc, A.FromJSON a) => +asJson :: (C.ResourceThrow m, C.IsSource bsrc, A.FromJSON a) => H.Response (bsrc m ByteString) -> C.ResourceT m (H.Response a) asJson (H.Response status headers body) = do val <- body C.$$ C.sinkParser A.json' case A.fromJSON val of - A.Error str -> fail $ "Facebook.Base.asJson: " ++ str A.Success r -> return (H.Response status headers r) + A.Error str -> + E.throw $ FbLibraryException $ T.concat + [ "Facebook.Base.asJson: could not parse " + , " Facebook's response as a JSON value (" + , T.pack str, ")" ] -- | Same as 'asJson', but returns only the JSON value. -asJson' :: (C.ResourceThrow m, C.BufferSource bsrc, A.FromJSON a) => +asJson' :: (C.ResourceThrow m, C.IsSource bsrc, A.FromJSON a) => H.Response (bsrc m ByteString) -> C.ResourceT m a asJson' = fmap H.responseBody . asJson @@ -166,7 +170,7 @@ fbhttp :: C.ResourceIO m => H.Request m -> H.Manager - -> C.ResourceT m (H.Response (C.BufferedSource m ByteString)) + -> C.ResourceT m (H.Response (C.Source m ByteString)) fbhttp req manager = do let req' = req { H.checkStatus = \_ _ -> Nothing } response@(H.Response status headers _) <- H.http req' manager diff --git a/src/Facebook/OpenGraph.hs b/src/Facebook/OpenGraph.hs new file mode 100644 --- /dev/null +++ b/src/Facebook/OpenGraph.hs @@ -0,0 +1,6 @@ +module Facebook.OpenGraph + ( -- * Raw interface to Facebook's Open Graph API + getObject + ) where + +import Facebook.OpenGraph.Base diff --git a/src/Facebook/OpenGraph/Base.hs b/src/Facebook/OpenGraph/Base.hs new file mode 100644 --- /dev/null +++ b/src/Facebook/OpenGraph/Base.hs @@ -0,0 +1,33 @@ +module Facebook.OpenGraph.Base + ( getObject + ) where + + +-- import Control.Applicative +-- import Control.Monad (mzero) +-- import Data.ByteString.Char8 (ByteString) +-- import Data.Text (Text) +-- import Data.Typeable (Typeable, Typeable1) +import Network.HTTP.Types (Ascii) + +-- 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 qualified Network.HTTP.Conduit as H +import qualified Network.HTTP.Types as HT + + +import Facebook.Base + + +-- | Make a raw request to Facebook's Open Graph API. Returns a +-- raw JSON 'A.Value'. +getObject :: C.ResourceIO m => + Ascii -- ^ Path (should begin with a slash @\/@) + -> HT.SimpleQuery -- ^ Arguments to be passed to Facebook + -> Maybe (AccessToken kind) -- ^ Optional access token + -> H.Manager -- ^ HTTP connection manager. + -> C.ResourceT m A.Value +getObject path query mtoken manager = + asJson' =<< fbhttp (fbreq path mtoken query) manager diff --git a/tests/runtests.hs b/tests/runtests.hs --- a/tests/runtests.hs +++ b/tests/runtests.hs @@ -1,15 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} +import Control.Applicative import Control.Monad.IO.Class (MonadIO(liftIO)) +import Data.Text (Text) import Data.Time (parseTime) import System.Environment (getEnv) import System.Exit (exitFailure) import System.IO.Error (isDoesNotExistError) +import qualified Data.Aeson as A +import qualified Data.Aeson.Types as A import qualified Data.ByteString.Char8 as B import qualified Control.Exception.Lifted as E import qualified Data.Conduit as C import qualified Facebook as FB +import qualified Facebook.OpenGraph as FBOG import qualified Network.HTTP.Conduit as H import Test.HUnit @@ -69,7 +74,7 @@ main = H.withManager $ \manager -> liftIO $ do creds <- getCredentials hspecX $ do - describe "getAppAccessToken" $ do + describe "Facebook.getAppAccessToken" $ do it "works and returns a valid app access token" $ do token <- FB.getAppAccessToken creds manager valid <- FB.isValid token manager @@ -79,13 +84,26 @@ case ret of Right token -> fail $ show token Left (_ :: FB.FacebookException) -> return () - describe "isValid" $ do + + describe "Facebook.isValid" $ do it "returns False on a clearly invalid user access token" $ do valid <- FB.isValid invalidUserAccessToken manager liftIO (valid @?= False) it "returns False on a clearly invalid app access token" $ do valid <- FB.isValid invalidAppAccessToken manager liftIO (valid @?= False) + + describe "Facebook.OpenGraph.getObject" $ do + it "is able to fetch Facebook's own page" $ do + A.Object obj <- FBOG.getObject "/19292868552" [] Nothing manager + let Just r = flip A.parseMaybe () $ const $ + (,,) <$> obj A..:? "id" + <*> obj A..:? "website" + <*> obj A..:? "name" + just x = Just (x :: Text) + liftIO $ r @?= ( just "19292868552" + , just "http://developers.facebook.com" + , just "Facebook Platform" ) -- | Sad, orphan instance.