fb 0.11 → 0.11.1

raw patch · 6 files changed

+263/−6 lines, 6 filesdep +base16-bytestringdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: base16-bytestring

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• fb.cabal +4/−2
• src/Facebook.hs +16/−0
• src/Facebook/Graph.hs +2/−4
• src/Facebook/OpenGraph.hs +3/−0
• src/Facebook/RealTime.hs +231/−0
• tests/runtests.hs +7/−0

@@ -1,5 +1,5 @@ name:              fb-version:           0.11+version:           0.11.1 license:           BSD3 license-file:      LICENSE author:            Felipe Lessa@@ -54,6 +54,7 @@     Facebook.Object.User     Facebook.Object.Page     Facebook.OpenGraph+    Facebook.RealTime   build-depends:       base               >= 4       && < 5     , lifted-base        >= 0.1     && < 0.2@@ -68,6 +69,7 @@     , attoparsec         >= 0.10    && < 0.11     , attoparsec-conduit >= 0.5     && < 0.6     , aeson              >= 0.5     && < 0.7+    , base16-bytestring  == 0.1.*     , base64-bytestring  >= 0.1.1   && < 0.2     , time               >= 1.2     && < 1.5     , old-locale@@ -103,7 +105,7 @@       -- Test-only dependencies     , HUnit     , QuickCheck-    , hspec >= 0.9.1 && < 1.3+    , hspec == 1.3.*     , fb   extensions:     TypeFamilies

@@ -58,6 +58,21 @@     , (#=)     , SimpleType(..) +      -- * Real-time update notifications+      -- ** Subscriptions+    , modifySubscription+    , listSubscriptions+    , RealTimeUpdateObject(..)+    , RealTimeUpdateField+    , RealTimeUpdateUrl+    , RealTimeUpdateToken+    , RealTimeUpdateSubscription(..)+      -- ** Notifications+    , verifyRealTimeUpdateNotifications+    , getRealTimeUpdateNotifications+    , RealTimeUpdateNotification(..)+    , RealTimeUpdateNotificationUserEntry(..)+       -- * Raw access to the Graph API     , getObject     , postObject@@ -81,3 +96,4 @@ import Facebook.Object.Page import Facebook.Object.User import Facebook.OpenGraph+import Facebook.RealTime

@@ -28,8 +28,7 @@ import Facebook.Base  --- | Make a raw @GET@ request to Facebook's Graph API.  Returns a--- raw JSON 'A.Value'.+-- | Make a raw @GET@ request to Facebook's Graph API. getObject :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>              ByteString     -- ^ Path (should begin with a slash @\/@)           -> [Argument]     -- ^ Arguments to be passed to Facebook@@ -40,8 +39,7 @@     asJson =<< fbhttp =<< fbreq path mtoken query  --- | Make a raw @POST@ request to Facebook's Graph API.  Returns--- a raw JSON 'A.Value'.+-- | Make a raw @POST@ request to Facebook's Graph API. postObject :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>               ByteString          -- ^ Path (should begin with a slash @\/@)            -> [Argument]          -- ^ Arguments to be passed to Facebook

@@ -219,6 +219,9 @@ -- | Facebook's simple type @String@. instance SimpleType Text where     encodeFbParam = TE.encodeUtf8+-- | Facebook's simple type @String@.+instance SimpleType ByteString where+    encodeFbParam = id  -- | An object's 'Id' code. instance SimpleType Id where

@@ -0,0 +1,231 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}+module Facebook.RealTime+    ( RealTimeUpdateObject(..)+    , RealTimeUpdateField+    , RealTimeUpdateUrl+    , RealTimeUpdateToken+    , modifySubscription+    , RealTimeUpdateSubscription(..)+    , listSubscriptions+    , verifyRealTimeUpdateNotifications+    , getRealTimeUpdateNotifications+    , RealTimeUpdateNotification(..)+    , RealTimeUpdateNotificationUserEntry(..)+    ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad (liftM, mzero)+import Data.ByteString.Char8 (ByteString)+import Data.Text (Text)+import Data.Typeable (Typeable)++import qualified Crypto.Classes as Crypto+import qualified Crypto.HMAC as Crypto+import qualified Crypto.Hash.SHA1 as SHA1+import qualified Data.Aeson as A+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.Conduit as C+import qualified Data.Text.Encoding as TE++import Facebook.Types+import Facebook.Monad+import Facebook.Graph+import Facebook.OpenGraph+++-- | The type of objects that a real-time update refers to.+data RealTimeUpdateObject =+    UserRTUO+  | PermissionsRTUO+  | PageRTUO+  | ErrorsRTUO+  | OtherRTUO Text+    deriving (Eq, Ord, Show, Typeable)++rtuoToBS :: RealTimeUpdateObject -> ByteString+rtuoToBS (UserRTUO)        = "user"+rtuoToBS (PermissionsRTUO) = "permissions"+rtuoToBS (PageRTUO)        = "page"+rtuoToBS (ErrorsRTUO)      = "errors"+rtuoToBS (OtherRTUO other) = TE.encodeUtf8 other++instance A.FromJSON RealTimeUpdateObject where+  parseJSON (A.String "user")        = return UserRTUO+  parseJSON (A.String "permissions") = return PermissionsRTUO+  parseJSON (A.String "page")        = return PageRTUO+  parseJSON (A.String "errors")      = return ErrorsRTUO+  parseJSON (A.String other)         = return (OtherRTUO other)+  parseJSON _ = mzero++instance A.ToJSON RealTimeUpdateObject where+  toJSON = A.String . TE.decodeUtf8 . rtuoToBS+++-- | A field of a 'RealTimeUpdateObject' that you would like to+-- receive notifications when changed.+type RealTimeUpdateField = ByteString+++-- | The URL on your server that will receive the real-time+-- updates.  Please refer to Facebook's documentation in order to+-- see what this URL needs to implement.+type RealTimeUpdateUrl = Text+++-- | A token that is sent back by Facebook's servers to your+-- server in order to verify that you really were trying to+-- modify your subscription.+type RealTimeUpdateToken = ByteString+++-- | Add or modify a subscription for real-time updates.  If+-- there were no previous subscriptions for the given+-- 'RealTimeUpdateObject', then a new subscription is created.+-- If there was any previous subscription for the given+-- 'RealTimeUpdateObject', it's overriden by this one (even if+-- the other subscription had a different callback URL).+modifySubscription :: (C.MonadResource m, MonadBaseControl IO m) =>+                      RealTimeUpdateObject+                      -- ^ Type of objects whose subscription you+                      -- and to add or modify.+                   -> [RealTimeUpdateField]+                      -- ^ Fields that you are interested in+                      -- receiving updates.+                   -> RealTimeUpdateUrl+                      -- ^ Your callback URL.+                   -> RealTimeUpdateToken+                      -- ^ A verification token.+                   -> AppAccessToken+                      -- ^ Access token for your app.+                   -> FacebookT Auth m ()+modifySubscription object fields callbackUrl verifyToken apptoken = do+  path <- getSubscriptionsPath+  let args = [ "object"       #= rtuoToBS object+             , "fields"       #= fields+             , "callback_url" #= callbackUrl+             , "verify_token" #= verifyToken+             ]+  postObject path args apptoken+++-- | (Internal)  Get the subscription's path.+getSubscriptionsPath :: Monad m => FacebookT Auth m ByteString+getSubscriptionsPath = do+  creds <- getCreds+  return $ B.concat ["/", appId creds, "/subscriptions"]+++-- | Information returned by Facebook about a real-time update+-- notification subscription.+data RealTimeUpdateSubscription =+  RealTimeUpdateSubscription {+    rtusObject      :: RealTimeUpdateObject+  , rtusCallbackUrl :: RealTimeUpdateUrl+  , rtusFields      :: [RealTimeUpdateField]+  , rtusActive      :: Bool+  } deriving (Eq, Ord, Show, Typeable)++instance A.FromJSON RealTimeUpdateSubscription where+  parseJSON (A.Object v) =+    RealTimeUpdateSubscription+      <$> v A..: "object"+      <*> v A..: "callback_url"+      <*> v A..: "fields"+      <*> v A..: "active"+  parseJSON _ = mzero+++-- | List current real-time update subscriptions.+listSubscriptions ::+  (C.MonadResource m, MonadBaseControl IO m) =>+  AppAccessToken -> FacebookT Auth m [RealTimeUpdateSubscription]+listSubscriptions apptoken = do+  path <- getSubscriptionsPath+  FQLResult ret <- getObject path [] (Just apptoken)+  return ret+++-- | Verifies the input's authenticity (i.e. it comes from+-- Facebook) and integrity by calculating its HMAC-SHA1 (using+-- your application secret as the key) and verifying that it+-- matches the value from the HTTP request's @X-Hub-Signature@+-- header's value.  If it's not valid, @Nothing@ is returned,+-- otherwise @Just data@ is returned where @data@ is the original+-- data.+verifyRealTimeUpdateNotifications ::+     Monad m =>+     ByteString+     -- ^ @X-Hub-Signature@ HTTP header's value.+  -> L.ByteString+     -- ^ Request body with JSON-encoded notifications.+  -> FacebookT Auth m (Maybe L.ByteString)+verifyRealTimeUpdateNotifications sig body = do+  creds <- getCreds+  let key :: Crypto.MacKey SHA1.Ctx SHA1.SHA1+      key = Crypto.MacKey (appSecret creds)+      hash = Crypto.hmac key body+      expected = "sha1=" <> Base16.encode (Crypto.encode hash)+  return $! if sig `Crypto.constTimeEq` expected then Just body else Nothing+++-- | Same as 'verifyRealTimeUpdateNotifications' but also parses+-- the response as JSON.  Returns @Nothing@ if either the+-- signature is invalid or the data can't be parsed (use+-- 'verifyRealTimeUpdateNotifications' if you need to distinguish+-- between these two error conditions).+getRealTimeUpdateNotifications ::+     (Monad m, A.FromJSON a) =>+     ByteString+     -- ^ @X-Hub-Signature@ HTTP header's value.+  -> L.ByteString+     -- ^ Request body with JSON-encoded notifications.+  -> FacebookT Auth m (Maybe (RealTimeUpdateNotification a))+getRealTimeUpdateNotifications =+  (liftM (>>= A.decode) .) . verifyRealTimeUpdateNotifications+++-- | When data changes and there's a valid subscription, Facebook+-- will @POST@ to your 'RealTimeUpdateUrl' with a JSON-encoded+-- object containing the notifications.  A+-- 'RealTimeUpdateNotification a' represents such object where+-- 'a' is type of the entries (e.g.,+-- 'RealTimeUpdateNotificationUserEntry').+--+-- If you have a single 'RealTimeUpdateUrl' for different kinds+-- of notifications, you may parse a @RealTimeUpdateNotification+-- 'A.Value'@ and then manually parse the 'A.Value' depending on+-- the value of 'rtunObject'.+--+-- We recommend using 'getRealTimeUpdateNotifications'.+data RealTimeUpdateNotification a =+  RealTimeUpdateNotification {+    rtunObject  :: RealTimeUpdateObject+  , rtunEntries :: [a]+  } deriving (Eq, Ord, Show, Typeable)++instance A.FromJSON a => A.FromJSON (RealTimeUpdateNotification a) where+  parseJSON (A.Object v) =+    RealTimeUpdateNotification+      <$> v A..: "object"+      <*> v A..: "entry"+  parseJSON _ = mzero+++-- | A notification for the 'UserRTUO' object.+data RealTimeUpdateNotificationUserEntry =+  RealTimeUpdateNotificationUserEntry {+    rtuneUserId        :: Id+  , rtuneChangedFields :: [RealTimeUpdateField]+  , rtuneTime          :: Integer+  } deriving (Eq, Ord, Show, Typeable)++instance A.FromJSON RealTimeUpdateNotificationUserEntry where+  parseJSON (A.Object v) =+    RealTimeUpdateNotificationUserEntry+      <$> v A..: "uid"+      <*> v A..: "changed_fields"+      <*> v A..: "time"+  parseJSON _ = mzero

@@ -167,6 +167,13 @@         r <- FB.fqlQuery "SELECT name FROM page WHERE page_id = 20531316728" Nothing         r &?= FB.FQLResult [PageName "Facebook"] +  describe' "listSubscriptions" $ do+    it "returns something" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        val   <- FB.listSubscriptions token+        length val `seq` return ()+ newtype PageName = PageName Text deriving (Eq, Show) instance A.FromJSON PageName where   parseJSON (A.Object v) = PageName <$> (v A..: "name")