fb 0.6.0.2 → 0.7

raw patch · 8 files changed

+201/−118 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• fb.cabal +1/−1
• src/Facebook.hs +2/−0
• src/Facebook/Auth.hs +48/−31
• src/Facebook/Base.hs +18/−10
• src/Facebook/Graph.hs +4/−3
• src/Facebook/Monad.hs +38/−4
• src/Facebook/Types.hs +2/−2
• tests/runtests.hs +88/−67

@@ -1,5 +1,5 @@ name:              fb-version:           0.6.0.2+version:           0.7 license:           BSD3 license-file:      LICENSE author:            Felipe Lessa

@@ -3,6 +3,8 @@       FacebookT     , runFacebookT     , runNoAuthFacebookT+    , beta_runFacebookT+    , beta_runNoAuthFacebookT     , Auth     , NoAuth 

@@ -46,8 +46,8 @@ getAppAccessToken =   runResourceInFb $ do     creds <- getCreds-    let req = fbreq "/oauth/access_token" Nothing $-              tsq creds [("grant_type", "client_credentials")]+    req   <- fbreq "/oauth/access_token" Nothing $+             tsq creds [("grant_type", "client_credentials")]     response <- fbhttp req     lift $       H.responseBody response C.$$@@ -59,19 +59,24 @@ -- Facebook URL you should redirect you user to.  Facebook will -- authenticate the user, authorize your app and then redirect -- the user back into the provider 'RedirectUrl'.-getUserAccessTokenStep1 :: Credentials-                        -> RedirectUrl+getUserAccessTokenStep1 :: Monad m =>+                           RedirectUrl                         -> [Permission]-                        -> Text-getUserAccessTokenStep1 creds redirectUrl perms =-  T.concat $ "https://www.facebook.com/dialog/oauth?client_id="-           : TE.decodeUtf8 (appId creds)-           : "&redirect_uri="-           : redirectUrl-           : (case perms of-                [] -> []-                _  -> "&scope=" : L.intersperse "," (map unPermission perms)-             )+                        -> FacebookT Auth m Text+getUserAccessTokenStep1 redirectUrl perms = do+  creds <- getCreds+  withTier $ \tier ->+    let urlBase = case tier of+                    Production -> "https://www.facebook.com/dialog/oauth?client_id="+                    Beta ->  "https://www.beta.facebook.com/dialog/oauth?client_id="+    in T.concat $ urlBase+                : TE.decodeUtf8 (appId creds)+                : "&redirect_uri="+                : redirectUrl+                : (case perms of+                     [] -> []+                     _  -> "&scope=" : L.intersperse "," (map unPermission perms)+                  )   -- | The second step to get an user access token.  If the user is@@ -80,11 +85,11 @@ -- passed to 'getUserAccessTokenStep1'.  You should take the -- request query parameters passed to your 'RedirectUrl' and give -- to this function that will complete the user authentication--- flow and give you an @'AccessToken' 'User'@.+-- flow and give you an @'UserAccessToken'@. getUserAccessTokenStep2 :: C.ResourceIO m =>                            RedirectUrl -- ^ Should be exactly the same                                        -- as in 'getUserAccessTokenStep1'.-                        -> [Argument]+                        -> [Argument]  -- ^ Query parameters.                         -> FacebookT Auth m UserAccessToken getUserAccessTokenStep2 redirectUrl query =   case query of@@ -92,12 +97,12 @@       -- Get the access token data through Facebook's OAuth.       now   <- liftIO getCurrentTime       creds <- getCreds-      let req = fbreq "/oauth/access_token" Nothing $-                tsq creds [code, ("redirect_uri", TE.encodeUtf8 redirectUrl)]+      req   <- fbreq "/oauth/access_token" Nothing $+               tsq creds [code, ("redirect_uri", TE.encodeUtf8 redirectUrl)]       preToken <- fmap (userAccessTokenParser now) . asBS =<< fbhttp req        -- Get user's ID throught Facebook's graph.-      userInfo <- asJson =<< fbhttp (fbreq "/me" (Just preToken) [("fields", "id")])+      userInfo <- asJson =<< fbhttp =<< fbreq "/me" (Just preToken) [("fields", "id")]       case (parseEither (.: "id") userInfo, preToken) of         (Left str, _) ->             E.throw $ FbLibraryException $ T.concat@@ -142,14 +147,26 @@ -- 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 :: 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 =-    TE.decodeUtf8 $-      "https://www.facebook.com/logout.php?" <>-      HT.renderQuery False [ ("next", Just (TE.encodeUtf8 next))-                           , ("access_token", Just data_) ]+getUserLogoutUrl :: Monad m =>+                    UserAccessToken+                    -- ^ The user's access token.+                 -> RedirectUrl+                    -- ^ URL the user should be directed to in+                    -- your site domain.+                 -> FacebookT Auth m Text+                    -- ^ Logout URL in+                    -- @https:\/\/www.facebook.com\/@ (or on+                    -- @https:\/\/www.beta.facebook.com\/@ when+                    -- using the beta tier).+getUserLogoutUrl (UserAccessToken _ data_ _) next = do+  withTier $ \tier ->+    let urlBase = case tier of+                    Production -> "https://www.facebook.com/logout.php?"+                    Beta ->  "https://www.beta.facebook.com/logout.php?"+    in TE.decodeUtf8 $+         urlBase <>+         HT.renderQuery False [ ("next", Just (TE.encodeUtf8 next))+                              , ("access_token", Just data_) ]   -- | URL where the user is redirected to after Facebook@@ -214,7 +231,7 @@                    -- will actually work with user access tokens,                    -- too, but they have another, better way of                    -- being checked.-      in httpCheck (fbreq page (Just token) [])+      in httpCheck =<< fbreq page (Just token) []   -- | Extend the expiration time of an user access token (see@@ -234,9 +251,9 @@     where       tryToExtend = runResourceInFb $ do         creds <- getCreds-        let req = fbreq "/oauth/access_token" Nothing $-                  tsq creds [ ("grant_type", "fb_exchange_token")-                            , ("fb_exchange_token", data_) ]+        req   <- fbreq "/oauth/access_token" Nothing $+                 tsq creds [ ("grant_type", "fb_exchange_token")+                           , ("fb_exchange_token", data_) ]         eresponse <- E.try (asBS =<< fbhttp req)         case eresponse of           Right response -> do

@@ -32,17 +32,25 @@  -- | 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 anyKind) -> HT.SimpleQuery -> H.Request m+fbreq :: Monad m =>+         HT.Ascii                    -- ^ Path.+      -> Maybe (AccessToken anyKind) -- ^ Access token.+      -> HT.SimpleQuery              -- ^ Parameters.+      -> FacebookT anyAuth m (H.Request n) fbreq path mtoken query =-    H.def { H.secure        = True-          , H.host          = "graph.facebook.com"-          , H.port          = 443-          , H.path          = path-          , H.redirectCount = 3-          , H.queryString   =-              HT.renderSimpleQuery False $-              maybe id tsq mtoken query-          }+    withTier $ \tier ->+      let host = case tier of+                   Production -> "graph.facebook.com"+                   Beta ->  "graph.beta.facebook.com"+      in H.def { H.secure        = True+               , H.host          = host+               , H.port          = 443+               , H.path          = path+               , H.redirectCount = 3+               , H.queryString   =+                   HT.renderSimpleQuery False $+                   maybe id tsq mtoken query+               }   -- | Internal class for types that may be passed on queries to

@@ -34,7 +34,7 @@           -> FacebookT anyAuth m a getObject path query mtoken =   runResourceInFb $-    asJson =<< fbhttp (fbreq path mtoken query)+    asJson =<< fbhttp =<< fbreq path mtoken query   -- | Make a raw @POST@ request to Facebook's Graph API.  Returns@@ -45,8 +45,9 @@            -> AccessToken anyKind -- ^ Access token            -> FacebookT Auth m a postObject path query token =-  runResourceInFb $-    asJson =<< fbhttp (fbreq path (Just token) query) { H.method = HT.methodPost }+  runResourceInFb $ do+    req <- fbreq path (Just token) query+    asJson =<< fbhttp req { H.method = HT.methodPost }   -- | The identification code of an object.

@@ -3,10 +3,15 @@     ( FacebookT     , Auth     , NoAuth+    , FbTier(..)     , runFacebookT     , runNoAuthFacebookT+    , beta_runFacebookT+    , beta_runNoAuthFacebookT     , getCreds     , getManager+    , getTier+    , withTier     , runResourceInFb        -- * Re-export@@ -64,25 +69,46 @@  -- | Internal data kept inside 'FacebookT'. data FbData = FbData { fbdCreds   :: Credentials -- ^ Can be 'undefined'!-                     , fbdManager :: !H.Manager }+                     , fbdManager :: !H.Manager+                     , fbdTier    :: !FbTier+                     }               deriving (Typeable) +-- | Which Facebook tier should be used (see+-- <https://developers.facebook.com/support/beta-tier/>).+data FbTier = Production | Beta deriving (Eq, Ord, Show, Read, Enum, 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)+runFacebookT creds manager (F act) =+    runReaderT act (FbData creds manager Production)  -- | 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"+runNoAuthFacebookT manager (F act) =+    let creds = error "runNoAuthFacebookT: never here, serious bug"+    in runReaderT act (FbData creds manager Production) +-- | Same as 'runFacebookT', but uses Facebook's beta tier (see+-- <https://developers.facebook.com/support/beta-tier/>).+beta_runFacebookT :: Credentials -> H.Manager -> FacebookT Auth m a -> m a+beta_runFacebookT creds manager (F act) =+    runReaderT act (FbData creds manager Beta) +-- | Same as 'runNoAuthFacebookT', but uses Facebook's beta tier+-- (see <https://developers.facebook.com/support/beta-tier/>).+beta_runNoAuthFacebookT :: H.Manager -> FacebookT NoAuth m a -> m a+beta_runNoAuthFacebookT manager (F act) =+    let creds = error "beta_runNoAuthFacebookT: never here, serious bug"+    in runReaderT act (FbData creds manager Beta)++ -- | Get the user's credentials. getCreds :: Monad m => FacebookT Auth m Credentials getCreds = fbdCreds `liftM` F ask@@ -90,6 +116,14 @@ -- | Get the 'H.Manager'. getManager :: Monad m => FacebookT anyAuth m H.Manager getManager = fbdManager `liftM` F ask++-- | Get the 'FbTier'.+getTier :: Monad m => FacebookT anyAuth m FbTier+getTier = fbdTier `liftM` F ask++-- | Run a pure function that depends on the 'FbTier' being used.+withTier :: Monad m => (FbTier -> a) -> FacebookT anyAuth m a+withTier = flip liftM getTier   -- | Run a 'ResourceT' inside a 'FacebookT'.

@@ -52,10 +52,10 @@     UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken UserKind     AppAccessToken  :: AccessTokenData -> AccessToken AppKind --- | Type synonym for @'AccessToken' 'UserKind'@+-- | Type synonym for @'AccessToken' 'UserKind'@. type UserAccessToken = AccessToken UserKind --- | Type synonym for @'AccessToken' 'AppKind'@+-- | Type synonym for @'AccessToken' 'AppKind'@. type AppAccessToken = AccessToken AppKind  

@@ -1,8 +1,9 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, Rank2Types #-}  import Control.Applicative import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Writer (Writer) import Data.Int (Int8, Int16, Int32) import Data.Text (Text) import Data.Time (parseTime)@@ -77,80 +78,100 @@ 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 "getAppAccessToken" $ do-      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 ())+    -- Run the tests twice, once in Facebook's production tier...+    facebookTests "Production tier: "+                  manager+                  (FB.runFacebookT creds manager)+                  (FB.runNoAuthFacebookT manager)+    -- ...and the other in Facebook's beta tier.+    facebookTests "Beta tier: "+                  manager+                  (FB.beta_runFacebookT creds manager)+                  (FB.beta_runNoAuthFacebookT manager) -    describe "isValid" $ do-      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+    -- Tests that don't depend on which tier is chosen.+    libraryTests -    describe "getObject" $ do-      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" )+facebookTests :: String+              -> H.Manager+              -> (forall a. FB.FacebookT FB.Auth   IO a -> IO a)+              -> (forall a. FB.FacebookT FB.NoAuth IO a -> IO a)+              -> Writer [Spec] ()+facebookTests pretitle manager runAuth runNoAuth = do+  let describe' = describe . (pretitle ++)+  describe' "getAppAccessToken" $ do+    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 "SimpleType" $ do-      it "works for Bool" $ (map FB.encodeFbParam [True, False]) @?= ["1", "0"]+  describe' "isValid" $ do+    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 -      let day       = TI.fromGregorian 2012 12 21-          time      = TI.TimeOfDay 11 37 22-          diffTime  = TI.secondsToDiffTime (11*3600 + 37*60)-          utcTime   = TI.UTCTime day diffTime-          localTime = TI.LocalTime day time-          zonedTime = TI.ZonedTime localTime (TI.minutesToTimeZone 30)-      it "works for Day"       $ FB.encodeFbParam day       @?= "2012-12-21"-      it "works for UTCTime"   $ FB.encodeFbParam utcTime   @?= "20121221T1137Z"-      it "works for ZonedTime" $ FB.encodeFbParam zonedTime @?= "20121221T1107Z"+  describe' "getObject" $ do+    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" ) -      let propShowRead :: (Show a, Read a, Eq a, FB.SimpleType a) => a -> Bool-          propShowRead x = read (T.unpack $ FB.encodeFbParam x) == x-      prop "works for Float"  (propShowRead :: Float  -> Bool)-      prop "works for Double" (propShowRead :: Double -> Bool)-      prop "works for Int"    (propShowRead :: Int    -> Bool)-      prop "works for Int8"   (propShowRead :: Int8   -> Bool)-      prop "works for Int16"  (propShowRead :: Int16  -> Bool)-      prop "works for Int32"  (propShowRead :: Int32  -> Bool)-      prop "works for Word"   (propShowRead :: Word   -> Bool)-      prop "works for Word8"  (propShowRead :: Word8  -> Bool)-      prop "works for Word16" (propShowRead :: Word16 -> Bool)-      prop "works for Word32" (propShowRead :: Word32 -> Bool)+  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 -      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+libraryTests :: Writer [Spec] ()+libraryTests = do+  describe "SimpleType" $ do+    it "works for Bool" $ (map FB.encodeFbParam [True, False]) @?= ["1", "0"]++    let day       = TI.fromGregorian 2012 12 21+        time      = TI.TimeOfDay 11 37 22+        diffTime  = TI.secondsToDiffTime (11*3600 + 37*60)+        utcTime   = TI.UTCTime day diffTime+        localTime = TI.LocalTime day time+        zonedTime = TI.ZonedTime localTime (TI.minutesToTimeZone 30)+    it "works for Day"       $ FB.encodeFbParam day       @?= "2012-12-21"+    it "works for UTCTime"   $ FB.encodeFbParam utcTime   @?= "20121221T1137Z"+    it "works for ZonedTime" $ FB.encodeFbParam zonedTime @?= "20121221T1107Z"++    let propShowRead :: (Show a, Read a, Eq a, FB.SimpleType a) => a -> Bool+        propShowRead x = read (T.unpack $ FB.encodeFbParam x) == x+    prop "works for Float"  (propShowRead :: Float  -> Bool)+    prop "works for Double" (propShowRead :: Double -> Bool)+    prop "works for Int"    (propShowRead :: Int    -> Bool)+    prop "works for Int8"   (propShowRead :: Int8   -> Bool)+    prop "works for Int16"  (propShowRead :: Int16  -> Bool)+    prop "works for Int32"  (propShowRead :: Int32  -> Bool)+    prop "works for Word"   (propShowRead :: Word   -> Bool)+    prop "works for Word8"  (propShowRead :: Word8  -> Bool)+    prop "works for Word16" (propShowRead :: Word16 -> Bool)+    prop "works for Word32" (propShowRead :: Word32 -> Bool)++    prop "works for Text" (\t -> FB.encodeFbParam t == t)   -- Wrappers for HUnit operators using MonadIO