fb 0.2.1 → 0.3

raw patch · 10 files changed

+346/−198 lines, 10 filesdep +monad-controldep +transformers-basedep ~conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-control, transformers-base

Dependency ranges changed: conduit

API changes (from Hackage documentation)

Files

• fb.cabal +11/−4
• src/Facebook.hs +17/−2
• src/Facebook/Auth.hs +36/−34
• src/Facebook/Base.hs +17/−80
• src/Facebook/Graph.hs +48/−0
• src/Facebook/Monad.hs +99/−0
• src/Facebook/OpenGraph.hs +0/−6
• src/Facebook/OpenGraph/Base.hs +0/−33
• src/Facebook/Types.hs +72/−0
• tests/runtests.hs +46/−39

@@ -1,5 +1,5 @@ name:              fb-version:           0.2.1+version:           0.3 license:           BSD3 license-file:      LICENSE author:            Felipe Lessa@@ -39,17 +39,20 @@   ghc-options: -Wall   exposed-modules:     Facebook-    Facebook.OpenGraph   other-modules:+    Facebook.Types+    Facebook.Monad     Facebook.Base     Facebook.Auth-    Facebook.OpenGraph.Base+    Facebook.Graph   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+    , transformers-base+    , monad-control     , conduit            >= 0.1.1.1 && < 0.2     , http-types     , http-conduit       >= 1.2     && < 1.3@@ -64,6 +67,10 @@     GADTs     StandaloneDeriving     ScopedTypeVariables+    GeneralizedNewtypeDeriving+    TypeFamilies+    FlexibleInstances+    MultiParamTypeClasses   test-suite runtests@@ -74,7 +81,7 @@   build-depends:       -- 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,+      base, lifted-base, transformers, bytestring,       http-conduit, text, time, aeson        -- Test-only dependencies

@@ -1,7 +1,14 @@ module Facebook-    ( -- * Authorization and Authentication+    ( -- * @FacebookT@ monad transformer+      FacebookT+    , runFacebookT+    , runNoAuthFacebookT+    , Auth+    , NoAuth++      -- * Authorization and Authentication       -- ** Credentials-      Credentials(..)+    , Credentials(..)       -- ** Access token     , AccessToken(..)     , AccessTokenData@@ -17,9 +24,17 @@     , getUserAccessTokenStep1     , getUserAccessTokenStep2     , extendUserAccessToken++      -- * Raw access to the Graph API+    , getObject+    , postObject+       -- * Exceptions     , FacebookException(..)     ) where +import Facebook.Types+import Facebook.Monad import Facebook.Base import Facebook.Auth+import Facebook.Graph

@@ -27,22 +27,26 @@ import qualified Network.HTTP.Conduit as H import qualified Network.HTTP.Types as HT ++import Facebook.Types import Facebook.Base+import Facebook.Monad   -- | Get an app access token from Facebook using your -- credentials. getAppAccessToken :: C.ResourceIO m =>-                     Credentials-                  -> H.Manager-                  -> C.ResourceT m (AccessToken App)-getAppAccessToken creds manager = do-  let req = fbreq "/oauth/access_token" Nothing $-            tsq creds [("grant_type", "client_credentials")]-  response <- fbhttp req manager-  H.responseBody response C.$$-    C.sinkParser (AppAccessToken <$  A.string "access_token="-                                 <*> A.takeByteString)+                     FacebookT Auth m (AccessToken App)+getAppAccessToken =+  runResourceInFb $ do+    creds <- getCreds+    let req = fbreq "/oauth/access_token" Nothing $+              tsq creds [("grant_type", "client_credentials")]+    response <- fbhttp req+    lift $+      H.responseBody response C.$$+      C.sinkParser (AppAccessToken <$  A.string "access_token="+                                   <*> A.takeByteString)   -- | The first step to get an user access token.  Returns the@@ -55,7 +59,7 @@                         -> Text getUserAccessTokenStep1 creds redirectUrl perms =   T.concat $ "https://www.facebook.com/dialog/oauth?client_id="-           : TE.decodeUtf8 (clientId creds)+           : TE.decodeUtf8 (appId creds)            : "&redirect_uri="            : redirectUrl            : (case perms of@@ -72,20 +76,19 @@ -- to this function that will complete the user authentication -- flow and give you an @'AccessToken' 'User'@. getUserAccessTokenStep2 :: C.ResourceIO m =>-                           Credentials-                        -> RedirectUrl -- ^ Should be exactly the same+                           RedirectUrl -- ^ Should be exactly the same                                        -- as in 'getUserAccessTokenStep1'.                         -> HT.SimpleQuery-                        -> H.Manager-                        -> C.ResourceT m (AccessToken User)-getUserAccessTokenStep2 creds redirectUrl query manager =+                        -> FacebookT Auth m (AccessToken User)+getUserAccessTokenStep2 redirectUrl query =   case query of-    [code@("code", _)] -> do-      now <- liftIO getCurrentTime+    [code@("code", _)] -> runResourceInFb $ do+      now   <- liftIO getCurrentTime+      creds <- getCreds       let req = fbreq "/oauth/access_token" Nothing $                 tsq creds [code, ("redirect_uri", TE.encodeUtf8 redirectUrl)]-      response <- fbhttp req manager-      H.responseBody response C.$$ C.sinkParser (userAccessTokenParser now)+      response <- fbhttp req+      lift $ H.responseBody response C.$$ C.sinkParser (userAccessTokenParser now)     _ -> let [error_, errorReason, errorDescr] =                  map (fromMaybe "" . flip lookup query)                      ["error", "error_reason", "error_description"]@@ -151,9 +154,8 @@ -- password, logged out from Facebook or blocked your app. isValid :: C.ResourceIO m =>            AccessToken kind-        -> H.Manager-        -> C.ResourceT m Bool-isValid token manager = do+        -> FacebookT anyAuth m Bool+isValid token = do   expired <- hasExpired token   if expired     then return False@@ -170,7 +172,7 @@                    -- will actually work with user access tokens,                    -- too, but they have another, better way of                    -- being checked.-      in httpCheck (fbreq page (Just token) []) manager+      in httpCheck (fbreq page (Just token) [])   -- | Extend the expiration time of an user access token (see@@ -180,26 +182,26 @@ -- the same data and expiration time as before, but you can't -- assume this).  Note that expired access tokens can't be -- extended, only valid tokens.-extendUserAccessToken :: C.ResourceIO m =>-                         Credentials-                      -> AccessToken User-                      -> H.Manager-                      -> C.ResourceT m (Either FacebookException (AccessToken User))-extendUserAccessToken creds token@(UserAccessToken data_ _) manager+extendUserAccessToken ::+    C.ResourceIO m =>+    AccessToken User+ -> FacebookT Auth m (Either FacebookException (AccessToken User))+extendUserAccessToken token@(UserAccessToken data_ _)     = do expired <- hasExpired token          if expired then return (Left hasExpiredExc) else tryToExtend     where-      tryToExtend = do+      tryToExtend = runResourceInFb $ do+        creds <- getCreds         let req = fbreq "/oauth/access_token" Nothing $                   tsq creds [ ("grant_type", "fb_exchange_token")                             , ("fb_exchange_token", data_) ]-        eresponse <- E.try (fbhttp req manager)+        eresponse <- E.try (fbhttp req)         case eresponse of           Right response -> do             now <- liftIO getCurrentTime             either (Left . couldn'tParseExc) Right <$>-              E.try (H.responseBody response C.$$-                     C.sinkParser (userAccessTokenParser now))+              E.try (lift $ H.responseBody response C.$$+                            C.sinkParser (userAccessTokenParser now))           Left exc -> return (Left exc)        hasExpiredExc =

@@ -1,12 +1,5 @@ module Facebook.Base-    ( Credentials(..)-    , AccessToken(..)-    , AccessTokenData-    , accessTokenData-    , accessTokenExpires-    , User-    , App-    , fbreq+    ( fbreq     , ToSimpleQuery(..)     , asJson     , asJson'@@ -19,9 +12,7 @@ import Control.Monad (mzero) import Data.ByteString.Char8 (ByteString) import Data.Text (Text)-import Data.Time (UTCTime)-import Data.Typeable (Typeable, Typeable1)-import Network.HTTP.Types (Ascii)+import Data.Typeable (Typeable)  import qualified Control.Exception.Lifted as E import qualified Data.Aeson as A@@ -33,62 +24,8 @@ import qualified Network.HTTP.Types as HT  --- | Credentials that you get for your app when you register on--- Facebook.-data Credentials =-    Credentials { clientId     :: Ascii -- ^ Your application ID.-                , clientSecret :: Ascii -- ^ Your application secret key.-                }-    deriving (Eq, Ord, Show, Typeable)----- | An access token.  While you can make some API calls without--- an access token, many require an access token and some will--- give you more information with an appropriate access token.------ There are two kinds of access tokens:------ [User access token] An access token obtained after an user--- accepts your application.  Let's you access more information--- about that user and act on their behalf (depending on which--- permissions you've asked for).------ [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'.-data AccessToken kind where-    UserAccessToken :: AccessTokenData -> UTCTime -> AccessToken User-    AppAccessToken  :: AccessTokenData -> AccessToken App--deriving instance Eq   (AccessToken kind)-deriving instance Ord  (AccessToken kind)-deriving instance Show (AccessToken kind)-deriving instance Typeable1 AccessToken---- | The access token data that is passed to Facebook's API--- calls.-type AccessTokenData = Ascii---- | Get the access token data.-accessTokenData :: AccessToken kind -> 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 (UserAccessToken _ expt) = Just expt-accessTokenExpires (AppAccessToken _)       = Nothing---- | Phantom type used mark an 'AccessToken' as an user access--- token.-data User deriving (Typeable)---- | Phantom type used mark an 'AccessToken' as an app access--- token.-data App deriving (Typeable)+import Facebook.Types+import Facebook.Monad   -- | A plain 'H.Request' to a Facebook API.  Use this instead of@@ -115,8 +52,8 @@     tsq _ = id  instance ToSimpleQuery Credentials where-    tsq creds = (:) ("client_id",     clientId     creds) .-                (:) ("client_secret", clientSecret creds)+    tsq creds = (:) ("client_id",     appId     creds) .+                (:) ("client_secret", appSecret creds)  instance ToSimpleQuery (AccessToken kind) where     tsq token = (:) ("access_token", accessTokenData token)@@ -126,9 +63,9 @@ -- response with a JSON value. asJson :: (C.ResourceThrow m, C.IsSource bsrc, A.FromJSON a) =>           H.Response (bsrc m ByteString)-       -> C.ResourceT m (H.Response a)+       -> FacebookT anyAuth (C.ResourceT m) (H.Response a) asJson (H.Response status headers body) = do-  val <- body C.$$ C.sinkParser A.json'+  val <- lift $ body C.$$ C.sinkParser A.json'   case A.fromJSON val of     A.Success r -> return (H.Response status headers r)     A.Error str ->@@ -141,7 +78,7 @@ -- | Same as 'asJson', but returns only the JSON value. asJson' :: (C.ResourceThrow m, C.IsSource bsrc, A.FromJSON a) =>            H.Response (bsrc m ByteString)-        -> C.ResourceT m a+        -> FacebookT anyAuth (C.ResourceT m) a asJson' = fmap H.responseBody . asJson  @@ -169,11 +106,11 @@ -- meaningful 'FacebookException'@s@. fbhttp :: C.ResourceIO m =>           H.Request m-       -> H.Manager-       -> C.ResourceT m (H.Response (C.Source m ByteString))-fbhttp req manager = do+       -> FacebookT anyAuth (C.ResourceT m) (H.Response (C.Source m ByteString))+fbhttp req = do+  manager <- getManager   let req' = req { H.checkStatus = \_ _ -> Nothing }-  response@(H.Response status headers _) <- H.http req' manager+  response@(H.Response status headers _) <- lift (H.http req' manager)   if isOkay status     then return response     else do@@ -205,12 +142,12 @@ -- code is 2XX (returns @True@) or not (returns @False@). httpCheck :: C.ResourceIO m =>              H.Request m-          -> H.Manager-          -> C.ResourceT m Bool-httpCheck req manager = do+          -> FacebookT anyAuth m Bool+httpCheck req = runResourceInFb $ do+  manager <- getManager   let req' = req { H.method      = HT.methodHead                  , H.checkStatus = \_ _ -> Nothing }-  H.Response status _ _ <- H.httpLbs req' manager+  H.Response status _ _ <- lift (H.httpLbs req' manager)   return $! isOkay status   -- Yes, we use httpLbs above so that we don't have to worry   -- about consuming the responseBody.  Note that the

@@ -0,0 +1,48 @@+module Facebook.Graph+    ( getObject+    , postObject+    ) 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.Types+import Facebook.Monad+import Facebook.Base+++-- | Make a raw @GET@ request to Facebook's 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+          -> FacebookT anyAuth m A.Value+getObject path query mtoken =+  runResourceInFb $+    asJson' =<< fbhttp (fbreq path mtoken query)+++-- | Make a raw @POST@ request to Facebook's Graph API.  Returns+-- a raw JSON 'A.Value'.+postObject :: C.ResourceIO m =>+              Ascii            -- ^ Path (should begin with a slash @\/@)+           -> HT.SimpleQuery   -- ^ Arguments to be passed to Facebook+           -> AccessToken kind -- ^ Access token+           -> FacebookT Auth m A.Value+postObject path query token =+  runResourceInFb $+    asJson' =<< fbhttp (fbreq path (Just token) query) { H.method = HT.methodPost }

@@ -0,0 +1,99 @@+{-# LANGUAGE UndecidableInstances #-}+module Facebook.Monad+    ( FacebookT+    , Auth+    , NoAuth+    , runFacebookT+    , runNoAuthFacebookT+    , getCreds+    , getManager+    , runResourceInFb++      -- * Re-export+    , lift+    ) where++import Control.Applicative (Applicative, Alternative)+import Control.Monad (MonadPlus, liftM)+import Control.Monad.Base (MonadBase(..))+import Control.Monad.Fix (MonadFix)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.Trans.Control ( MonadTransControl(..), MonadBaseControl(..)+                                   , ComposeSt, defaultLiftBaseWith+                                   , defaultRestoreM )+import Control.Monad.Trans.Reader (ReaderT(..), ask)+import Data.Typeable (Typeable)++import qualified Data.Conduit as C+import qualified Network.HTTP.Conduit as H++import Facebook.Types+++-- | @FacebookT auth m a@ is this library's monad transformer.+-- Contains information needed to issue commands and queries to+-- Facebook.  The phantom type @auth@ may be either 'Auth' (you+-- have supplied your 'Credentials') or 'NoAuth' (you have not+-- supplied any 'Credentials').+newtype FacebookT auth m a = F { unF :: ReaderT FbData m a }+    deriving ( Functor, Applicative, Alternative, Monad+             , MonadFix, MonadPlus, MonadIO, MonadTrans )++instance MonadBase b m => MonadBase b (FacebookT auth m) where+    liftBase = lift . liftBase++instance MonadTransControl (FacebookT auth) where+    newtype StT (FacebookT auth) a = FbStT { unFbStT :: StT (ReaderT FbData) a }+    liftWith f = F $ liftWith (\run -> f (liftM FbStT . run . unF))+    restoreT   = F . restoreT . liftM unFbStT++instance MonadBaseControl b m => MonadBaseControl b (FacebookT auth m) where+    newtype StM (FacebookT auth m) a = StMT {unStMT :: ComposeSt (FacebookT auth) m a}+    liftBaseWith = defaultLiftBaseWith StMT+    restoreM     = defaultRestoreM   unStMT++-- | Phantom type stating that you have provided your+-- 'Credentials' and thus have access to the whole API.+data Auth deriving (Typeable)++-- | Phantom type stating that you have /not/ provided your+-- 'Credentials'.  This means that you'll be limited about which+-- APIs you'll be able use.+data NoAuth deriving (Typeable)++-- | Internal data kept inside 'FacebookT'.+data FbData = FbData { fbdCreds   :: Credentials -- ^ Can be 'undefined'!+                     , fbdManager :: !H.Manager }+              deriving (Typeable)+++-- | Run a computation in the 'FacebookT' monad transformer with+-- your credentials.+runFacebookT :: Credentials         -- ^ Your app's credentials.+             -> H.Manager           -- ^ Connection manager (see 'H.withManager').+             -> FacebookT Auth m a+             -> m a+runFacebookT creds manager (F act) = runReaderT act (FbData creds manager)++-- | Run a computation in the 'FacebookT' monad without+-- credentials.+runNoAuthFacebookT :: H.Manager -> FacebookT NoAuth m a -> m a+runNoAuthFacebookT manager (F act) = runReaderT act (FbData creds manager)+    where creds = error "runNoAuthFacebookT: never here, serious bug"+++-- | Get the user's credentials.+getCreds :: Monad m => FacebookT Auth m Credentials+getCreds = fbdCreds `liftM` F ask++-- | Get the 'H.Manager'.+getManager :: Monad m => FacebookT anyAuth m H.Manager+getManager = fbdManager `liftM` F ask+++-- | Run a 'ResourceT' inside a 'FacebookT'.+runResourceInFb :: C.Resource m =>+                   FacebookT anyAuth (C.ResourceT m) a+                -> FacebookT anyAuth m a+runResourceInFb (F inner) = F $ ask >>= lift . C.runResourceT . runReaderT inner

@@ -1,6 +0,0 @@-module Facebook.OpenGraph-    ( -- * Raw interface to Facebook's Open Graph API-      getObject-    ) where--import Facebook.OpenGraph.Base

@@ -1,33 +0,0 @@-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

@@ -0,0 +1,72 @@+module Facebook.Types+    ( Credentials(..)+    , AccessToken(..)+    , AccessTokenData+    , accessTokenData+    , accessTokenExpires+    , User+    , App+    ) where++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.+                }+    deriving (Eq, Ord, Show, Typeable)+++-- | An access token.  While you can make some API calls without+-- an access token, many require an access token and some will+-- give you more information with an appropriate access token.+--+-- There are two kinds of access tokens:+--+-- [User access token] An access token obtained after an user+-- accepts your application.  Let's you access more information+-- about that user and act on their behalf (depending on which+-- permissions you've asked for).+--+-- [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'.+data AccessToken kind where+    UserAccessToken :: AccessTokenData -> UTCTime -> AccessToken User+    AppAccessToken  :: AccessTokenData -> AccessToken App++deriving instance Eq   (AccessToken kind)+deriving instance Ord  (AccessToken kind)+deriving instance Show (AccessToken kind)+deriving instance Typeable1 AccessToken++-- | The access token data that is passed to Facebook's API+-- calls.+type AccessTokenData = Ascii++-- | Get the access token data.+accessTokenData :: AccessToken kind -> 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 (UserAccessToken _ expt) = Just expt+accessTokenExpires (AppAccessToken _)       = Nothing++-- | Phantom type used mark an 'AccessToken' as an user access+-- token.+data User deriving (Typeable)++-- | Phantom type used mark an 'AccessToken' as an app access+-- token.+data App deriving (Typeable)

@@ -2,6 +2,7 @@  import Control.Applicative import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Trans.Class (lift) import Data.Text (Text) import Data.Time (parseTime) import System.Environment (getEnv)@@ -12,13 +13,10 @@ 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-import Test.Hspec.Core (Example(..))+import qualified Test.HUnit as HU import Test.Hspec.Monadic -- import Test.Hspec.QuickCheck import Test.Hspec.HUnit ()@@ -29,8 +27,8 @@ getCredentials = tryToGet `E.catch` showHelp     where       tryToGet = do-        [appId, appSecret] <- mapM getEnv ["APP_ID", "APP_SECRET"]-        return $ FB.Credentials (B.pack appId) (B.pack appSecret)+        [appName, appId, appSecret] <- mapM getEnv ["APP_NAME", "APP_ID", "APP_SECRET"]+        return $ FB.Credentials (B.pack appName) (B.pack appId) (B.pack appSecret)        showHelp exc | not (isDoesNotExistError exc) = E.throw exc       showHelp _ = do@@ -41,14 +39,15 @@           , "create a Facebook app for this purpose and then distribute"           , "its secret keys in the open."           , ""-          , "Please give your app id and app secret on the enviroment"-          , "variables APP_ID and APP_SECRET, respectively.  For example,"-          , "before running the test you could run in the shell:"+          , "Please give your app's name, id and secret on the enviroment"+          , "variables APP_NAME, APP_ID and APP_SECRET, respectively.  "+          , "For example, before running the test you could run in the shell:"           , ""+          , "  $ export APP_NAME=\"example\""           , "  $ export APP_ID=\"458798571203498\""           , "  $ export APP_SECRET=\"28a9d0fa4272a14a9287f423f90a48f2304\""           , ""-          , "Of course, the values above aren't valid and you need to"+          , "Of course, these values above aren't valid and you need to"           , "replace them with your own."           , ""           , "(Exiting now with a failure code.)"]@@ -56,7 +55,7 @@   invalidCredentials :: FB.Credentials-invalidCredentials = FB.Credentials "not" "valid"+invalidCredentials = FB.Credentials "this" "isn't" "valid"  invalidUserAccessToken :: FB.AccessToken FB.User invalidUserAccessToken = FB.UserAccessToken "invalid" farInTheFuture@@ -73,39 +72,47 @@ main :: IO () main = H.withManager $ \manager -> liftIO $ do   creds <- getCredentials+  let runAuth   :: FB.FacebookT FB.Auth   IO a -> IO a+      runAuth   = FB.runFacebookT creds manager+      runNoAuth :: FB.FacebookT FB.NoAuth IO a -> IO a+      runNoAuth = FB.runNoAuthFacebookT manager   hspecX $ 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-        liftIO (valid @?= True)-      it "throws a FacebookException on invalid credentials" $ do-        ret <- E.try $ FB.getAppAccessToken invalidCredentials manager-        case ret  of-          Right token                      -> fail $ show token-          Left (_ :: FB.FacebookException) -> return ()+      it "works and returns a valid app access token" $+        runAuth $ do+          token <- FB.getAppAccessToken+          FB.isValid token #?= True+      it "throws a FacebookException on invalid credentials" $+        FB.runFacebookT invalidCredentials manager $ do+          ret <- E.try $ FB.getAppAccessToken+          case ret  of+            Right token                      -> fail $ show token+            Left (_ :: FB.FacebookException) -> lift (return () :: IO ())      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)+      it "returns False on a clearly invalid user access token" $+        runNoAuth $ FB.isValid invalidUserAccessToken #?= False+      it "returns False on a clearly invalid app access token" $+        runNoAuth $ FB.isValid invalidAppAccessToken  #?= 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" )+      it "is able to fetch Facebook's own page" $+        runNoAuth $ do+          A.Object obj <- FB.getObject "/19292868552" [] Nothing+          let Just r = flip A.parseMaybe () $ const $+                       (,,) <$> obj A..:? "id"+                            <*> obj A..:? "website"+                            <*> obj A..:? "name"+              just x = Just (x :: Text)+          r @?= ( just "19292868552"+                , just "http://developers.facebook.com"+                , just "Facebook Platform" )  --- | Sad, orphan instance.-instance (m ~ IO, r ~ ()) => Example (C.ResourceT m r) where-    evaluateExample = evaluateExample . C.runResourceT+-- Wrappers for HUnit operators using MonadIO++(@?=) :: (Eq a, Show a, MonadIO m) => a -> a -> m ()+v @?= e = liftIO (v HU.@?= e)++(#?=) :: (Eq a, Show a, MonadIO m) => m a -> a -> m ()+m #?= e = m >>= (@?= e)