{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Facebook.RealTime
  ( RealTimeUpdateObject(..)
  , RealTimeUpdateField
  , RealTimeUpdateUrl
  , RealTimeUpdateToken
  , modifySubscription
  , RealTimeUpdateSubscription(..)
  , listSubscriptions
  , verifyRealTimeUpdateNotifications
  , getRealTimeUpdateNotifications
  , RealTimeUpdateNotification(..)
  , RealTimeUpdateNotificationUserEntry(..)
  ) where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (liftM, mzero, void)
import Control.Monad.IO.Class
import qualified Control.Monad.Trans.Resource as R
import Crypto.Hash.Algorithms (SHA1)
import Crypto.MAC.HMAC (HMAC(..), hmac)
import qualified Data.Aeson as A
import Data.ByteArray (ScrubbedBytes, convert)
import Data.ByteArray.Encoding (Base(..), convertToBase)
import qualified Data.ByteString as B
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.Encoding as TE
import Data.Typeable (Typeable)
import qualified Network.HTTP.Conduit as H
import qualified Network.HTTP.Types as HT

import Facebook.Base
import Facebook.Graph
import Facebook.Monad
import Facebook.Pager
import Facebook.Types

-- | The type of objects that a real-time update refers to.
data RealTimeUpdateObject
  = UserRTUO
  | PermissionsRTUO
  | PageRTUO
  | ErrorsRTUO
  | OtherRTUO Text
  deriving (RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
(RealTimeUpdateObject -> RealTimeUpdateObject -> Bool)
-> (RealTimeUpdateObject -> RealTimeUpdateObject -> Bool)
-> Eq RealTimeUpdateObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
$c/= :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
== :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
$c== :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
Eq, Eq RealTimeUpdateObject
Eq RealTimeUpdateObject
-> (RealTimeUpdateObject -> RealTimeUpdateObject -> Ordering)
-> (RealTimeUpdateObject -> RealTimeUpdateObject -> Bool)
-> (RealTimeUpdateObject -> RealTimeUpdateObject -> Bool)
-> (RealTimeUpdateObject -> RealTimeUpdateObject -> Bool)
-> (RealTimeUpdateObject -> RealTimeUpdateObject -> Bool)
-> (RealTimeUpdateObject
    -> RealTimeUpdateObject -> RealTimeUpdateObject)
-> (RealTimeUpdateObject
    -> RealTimeUpdateObject -> RealTimeUpdateObject)
-> Ord RealTimeUpdateObject
RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
RealTimeUpdateObject -> RealTimeUpdateObject -> Ordering
RealTimeUpdateObject
-> RealTimeUpdateObject -> RealTimeUpdateObject
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RealTimeUpdateObject
-> RealTimeUpdateObject -> RealTimeUpdateObject
$cmin :: RealTimeUpdateObject
-> RealTimeUpdateObject -> RealTimeUpdateObject
max :: RealTimeUpdateObject
-> RealTimeUpdateObject -> RealTimeUpdateObject
$cmax :: RealTimeUpdateObject
-> RealTimeUpdateObject -> RealTimeUpdateObject
>= :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
$c>= :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
> :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
$c> :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
<= :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
$c<= :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
< :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
$c< :: RealTimeUpdateObject -> RealTimeUpdateObject -> Bool
compare :: RealTimeUpdateObject -> RealTimeUpdateObject -> Ordering
$ccompare :: RealTimeUpdateObject -> RealTimeUpdateObject -> Ordering
$cp1Ord :: Eq RealTimeUpdateObject
Ord, Int -> RealTimeUpdateObject -> ShowS
[RealTimeUpdateObject] -> ShowS
RealTimeUpdateObject -> String
(Int -> RealTimeUpdateObject -> ShowS)
-> (RealTimeUpdateObject -> String)
-> ([RealTimeUpdateObject] -> ShowS)
-> Show RealTimeUpdateObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RealTimeUpdateObject] -> ShowS
$cshowList :: [RealTimeUpdateObject] -> ShowS
show :: RealTimeUpdateObject -> String
$cshow :: RealTimeUpdateObject -> String
showsPrec :: Int -> RealTimeUpdateObject -> ShowS
$cshowsPrec :: Int -> RealTimeUpdateObject -> ShowS
Show, Typeable)

rtuoToBS :: RealTimeUpdateObject -> ByteString
rtuoToBS :: RealTimeUpdateObject -> ByteString
rtuoToBS (RealTimeUpdateObject
UserRTUO) = ByteString
"user"
rtuoToBS (RealTimeUpdateObject
PermissionsRTUO) = ByteString
"permissions"
rtuoToBS (RealTimeUpdateObject
PageRTUO) = ByteString
"page"
rtuoToBS (RealTimeUpdateObject
ErrorsRTUO) = ByteString
"errors"
rtuoToBS (OtherRTUO Text
other) = Text -> ByteString
TE.encodeUtf8 Text
other

instance A.FromJSON RealTimeUpdateObject where
  parseJSON :: Value -> Parser RealTimeUpdateObject
parseJSON (A.String Text
"user") = RealTimeUpdateObject -> Parser RealTimeUpdateObject
forall (m :: * -> *) a. Monad m => a -> m a
return RealTimeUpdateObject
UserRTUO
  parseJSON (A.String Text
"permissions") = RealTimeUpdateObject -> Parser RealTimeUpdateObject
forall (m :: * -> *) a. Monad m => a -> m a
return RealTimeUpdateObject
PermissionsRTUO
  parseJSON (A.String Text
"page") = RealTimeUpdateObject -> Parser RealTimeUpdateObject
forall (m :: * -> *) a. Monad m => a -> m a
return RealTimeUpdateObject
PageRTUO
  parseJSON (A.String Text
"errors") = RealTimeUpdateObject -> Parser RealTimeUpdateObject
forall (m :: * -> *) a. Monad m => a -> m a
return RealTimeUpdateObject
ErrorsRTUO
  parseJSON (A.String Text
other) = RealTimeUpdateObject -> Parser RealTimeUpdateObject
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> RealTimeUpdateObject
OtherRTUO Text
other)
  parseJSON Value
_ = Parser RealTimeUpdateObject
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance A.ToJSON RealTimeUpdateObject where
  toJSON :: RealTimeUpdateObject -> Value
toJSON = Text -> Value
A.String (Text -> Value)
-> (RealTimeUpdateObject -> Text) -> RealTimeUpdateObject -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (RealTimeUpdateObject -> ByteString)
-> RealTimeUpdateObject
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTimeUpdateObject -> ByteString
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 ::
     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow 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 :: RealTimeUpdateObject
-> [ByteString]
-> Text
-> ByteString
-> AppAccessToken
-> FacebookT Auth m ()
modifySubscription RealTimeUpdateObject
object [ByteString]
fields Text
callbackUrl ByteString
verifyToken AppAccessToken
apptoken = do
  Text
path <- FacebookT Auth m Text
forall (m :: * -> *). (Monad m, MonadIO m) => FacebookT Auth m Text
getSubscriptionsPath
  let args :: [Argument]
args =
        [ ByteString
"object" ByteString -> ByteString -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= RealTimeUpdateObject -> ByteString
rtuoToBS RealTimeUpdateObject
object
        , ByteString
"fields" ByteString -> [ByteString] -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= [ByteString]
fields
        , ByteString
"callback_url" ByteString -> Text -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= Text
callbackUrl
        , ByteString
"verify_token" ByteString -> ByteString -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= ByteString
verifyToken
        ]
  FacebookT Auth (ResourceT m) () -> FacebookT Auth m ()
forall (m :: * -> *) anyAuth a.
(MonadResource m, MonadUnliftIO m) =>
FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
runResourceInFb (FacebookT Auth (ResourceT m) () -> FacebookT Auth m ())
-> FacebookT Auth (ResourceT m) () -> FacebookT Auth m ()
forall a b. (a -> b) -> a -> b
$ do
    Request
req <- Text
-> Maybe AppAccessToken
-> [Argument]
-> FacebookT Auth (ResourceT m) Request
forall (m :: * -> *) anyKind anyAuth.
MonadIO m =>
Text
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT anyAuth m Request
fbreq Text
path (AppAccessToken -> Maybe AppAccessToken
forall a. a -> Maybe a
Just AppAccessToken
apptoken) [Argument]
args
    FacebookT
  Auth
  (ResourceT m)
  (Response (ConduitT () ByteString (ResourceT m) ()))
-> FacebookT Auth (ResourceT m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FacebookT
   Auth
   (ResourceT m)
   (Response (ConduitT () ByteString (ResourceT m) ()))
 -> FacebookT Auth (ResourceT m) ())
-> FacebookT
     Auth
     (ResourceT m)
     (Response (ConduitT () ByteString (ResourceT m) ()))
-> FacebookT Auth (ResourceT m) ()
forall a b. (a -> b) -> a -> b
$ Request
-> FacebookT
     Auth
     (ResourceT m)
     (Response (ConduitT () ByteString (ResourceT m) ()))
forall (m :: * -> *) anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Request
-> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
fbhttp Request
req {method :: ByteString
H.method = ByteString
HT.methodPost}
  () -> FacebookT Auth m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | (Internal)  Get the subscription's path.
getSubscriptionsPath :: (Monad m, MonadIO m) => FacebookT Auth m Text
getSubscriptionsPath :: FacebookT Auth m Text
getSubscriptionsPath = do
  Credentials
creds <- FacebookT Auth m Credentials
forall (m :: * -> *).
(Monad m, MonadIO m) =>
FacebookT Auth m Credentials
getCreds
  Text -> FacebookT Auth m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> FacebookT Auth m Text) -> Text -> FacebookT Auth m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"/", Credentials -> Text
appId Credentials
creds, Text
"/subscriptions"]

-- | Information returned by Facebook about a real-time update
-- notification subscription.
data RealTimeUpdateSubscription =
  RealTimeUpdateSubscription
    { RealTimeUpdateSubscription -> RealTimeUpdateObject
rtusObject :: RealTimeUpdateObject
    , RealTimeUpdateSubscription -> Text
rtusCallbackUrl :: RealTimeUpdateUrl
    , RealTimeUpdateSubscription -> [ByteString]
rtusFields :: [RealTimeUpdateField]
    , RealTimeUpdateSubscription -> Bool
rtusActive :: Bool
    }
  deriving (RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
(RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool)
-> (RealTimeUpdateSubscription
    -> RealTimeUpdateSubscription -> Bool)
-> Eq RealTimeUpdateSubscription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
$c/= :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
== :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
$c== :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
Eq, Eq RealTimeUpdateSubscription
Eq RealTimeUpdateSubscription
-> (RealTimeUpdateSubscription
    -> RealTimeUpdateSubscription -> Ordering)
-> (RealTimeUpdateSubscription
    -> RealTimeUpdateSubscription -> Bool)
-> (RealTimeUpdateSubscription
    -> RealTimeUpdateSubscription -> Bool)
-> (RealTimeUpdateSubscription
    -> RealTimeUpdateSubscription -> Bool)
-> (RealTimeUpdateSubscription
    -> RealTimeUpdateSubscription -> Bool)
-> (RealTimeUpdateSubscription
    -> RealTimeUpdateSubscription -> RealTimeUpdateSubscription)
-> (RealTimeUpdateSubscription
    -> RealTimeUpdateSubscription -> RealTimeUpdateSubscription)
-> Ord RealTimeUpdateSubscription
RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
RealTimeUpdateSubscription
-> RealTimeUpdateSubscription -> Ordering
RealTimeUpdateSubscription
-> RealTimeUpdateSubscription -> RealTimeUpdateSubscription
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RealTimeUpdateSubscription
-> RealTimeUpdateSubscription -> RealTimeUpdateSubscription
$cmin :: RealTimeUpdateSubscription
-> RealTimeUpdateSubscription -> RealTimeUpdateSubscription
max :: RealTimeUpdateSubscription
-> RealTimeUpdateSubscription -> RealTimeUpdateSubscription
$cmax :: RealTimeUpdateSubscription
-> RealTimeUpdateSubscription -> RealTimeUpdateSubscription
>= :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
$c>= :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
> :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
$c> :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
<= :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
$c<= :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
< :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
$c< :: RealTimeUpdateSubscription -> RealTimeUpdateSubscription -> Bool
compare :: RealTimeUpdateSubscription
-> RealTimeUpdateSubscription -> Ordering
$ccompare :: RealTimeUpdateSubscription
-> RealTimeUpdateSubscription -> Ordering
$cp1Ord :: Eq RealTimeUpdateSubscription
Ord, Int -> RealTimeUpdateSubscription -> ShowS
[RealTimeUpdateSubscription] -> ShowS
RealTimeUpdateSubscription -> String
(Int -> RealTimeUpdateSubscription -> ShowS)
-> (RealTimeUpdateSubscription -> String)
-> ([RealTimeUpdateSubscription] -> ShowS)
-> Show RealTimeUpdateSubscription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RealTimeUpdateSubscription] -> ShowS
$cshowList :: [RealTimeUpdateSubscription] -> ShowS
show :: RealTimeUpdateSubscription -> String
$cshow :: RealTimeUpdateSubscription -> String
showsPrec :: Int -> RealTimeUpdateSubscription -> ShowS
$cshowsPrec :: Int -> RealTimeUpdateSubscription -> ShowS
Show, Typeable)

instance A.FromJSON RealTimeUpdateSubscription where
  parseJSON :: Value -> Parser RealTimeUpdateSubscription
parseJSON (A.Object Object
v) =
    RealTimeUpdateObject
-> Text -> [ByteString] -> Bool -> RealTimeUpdateSubscription
RealTimeUpdateSubscription (RealTimeUpdateObject
 -> Text -> [ByteString] -> Bool -> RealTimeUpdateSubscription)
-> Parser RealTimeUpdateObject
-> Parser
     (Text -> [ByteString] -> Bool -> RealTimeUpdateSubscription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser RealTimeUpdateObject
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"object" Parser (Text -> [ByteString] -> Bool -> RealTimeUpdateSubscription)
-> Parser Text
-> Parser ([ByteString] -> Bool -> RealTimeUpdateSubscription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"callback_url" Parser ([ByteString] -> Bool -> RealTimeUpdateSubscription)
-> Parser [ByteString]
-> Parser (Bool -> RealTimeUpdateSubscription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    ([Text] -> [ByteString]) -> Parser [Text] -> Parser [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ByteString
encodeUtf8) (Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"fields") Parser (Bool -> RealTimeUpdateSubscription)
-> Parser Bool -> Parser RealTimeUpdateSubscription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"active"
  parseJSON Value
_ = Parser RealTimeUpdateSubscription
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | List current real-time update subscriptions.
listSubscriptions ::
     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)
  => AppAccessToken
  -> FacebookT Auth m [RealTimeUpdateSubscription]
listSubscriptions :: AppAccessToken -> FacebookT Auth m [RealTimeUpdateSubscription]
listSubscriptions AppAccessToken
apptoken = do
  Text
path <- FacebookT Auth m Text
forall (m :: * -> *). (Monad m, MonadIO m) => FacebookT Auth m Text
getSubscriptionsPath
  Pager RealTimeUpdateSubscription
pager <- Text
-> [Argument]
-> Maybe AppAccessToken
-> FacebookT Auth m (Pager RealTimeUpdateSubscription)
forall (m :: * -> *) a anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject Text
path [] (AppAccessToken -> Maybe AppAccessToken
forall a. a -> Maybe a
Just AppAccessToken
apptoken)
  ConduitT () RealTimeUpdateSubscription m ()
src <- Pager RealTimeUpdateSubscription
-> FacebookT Auth m (ConduitT () RealTimeUpdateSubscription m ())
forall (m :: * -> *) a (n :: * -> *) anyAuth.
(Monad m, FromJSON a, MonadUnliftIO n, MonadThrow n) =>
Pager a -> FacebookT anyAuth m (ConduitT () a n ())
fetchAllNextPages Pager RealTimeUpdateSubscription
pager
  m [RealTimeUpdateSubscription]
-> FacebookT Auth m [RealTimeUpdateSubscription]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [RealTimeUpdateSubscription]
 -> FacebookT Auth m [RealTimeUpdateSubscription])
-> m [RealTimeUpdateSubscription]
-> FacebookT Auth m [RealTimeUpdateSubscription]
forall a b. (a -> b) -> a -> b
$ ConduitT () Void m [RealTimeUpdateSubscription]
-> m [RealTimeUpdateSubscription]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit (ConduitT () Void m [RealTimeUpdateSubscription]
 -> m [RealTimeUpdateSubscription])
-> ConduitT () Void m [RealTimeUpdateSubscription]
-> m [RealTimeUpdateSubscription]
forall a b. (a -> b) -> a -> b
$ ConduitT () RealTimeUpdateSubscription m ()
src ConduitT () RealTimeUpdateSubscription m ()
-> ConduitM
     RealTimeUpdateSubscription Void m [RealTimeUpdateSubscription]
-> ConduitT () Void m [RealTimeUpdateSubscription]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM
  RealTimeUpdateSubscription Void m [RealTimeUpdateSubscription]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume

-- | Verifi(es the input's authenticity (i.e. it comes from, MonadIO m)
-- 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, MonadIO m)
  => ByteString
     -- ^ @X-Hub-Signature@ HTTP header's value.
  -> L.ByteString
     -- ^ Request body with JSON-encoded notifications.
  -> FacebookT Auth m (Maybe L.ByteString)
verifyRealTimeUpdateNotifications :: ByteString -> ByteString -> FacebookT Auth m (Maybe ByteString)
verifyRealTimeUpdateNotifications ByteString
sig ByteString
body = do
  Credentials
creds <- FacebookT Auth m Credentials
forall (m :: * -> *).
(Monad m, MonadIO m) =>
FacebookT Auth m Credentials
getCreds
  let hmacData :: HMAC SHA1
      hmacData :: HMAC SHA1
hmacData = ByteString -> ByteString -> HMAC SHA1
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac (Credentials -> ByteString
appSecretBS Credentials
creds) (ByteString -> ByteString
L.toStrict ByteString
body)
      hash :: B.ByteString
      hash :: ByteString
hash = Base -> HMAC SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 HMAC SHA1
hmacData
      expected :: ByteString
expected = ByteString
"sha1=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
hash
  Maybe ByteString -> FacebookT Auth m (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> FacebookT Auth m (Maybe ByteString))
-> Maybe ByteString -> FacebookT Auth m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$!
    if ((ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
sig :: ScrubbedBytes) ScrubbedBytes -> ScrubbedBytes -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
expected))
      then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body
      else Maybe ByteString
forall a. Maybe a
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, MonadIO m)
  => ByteString
     -- ^ @X-Hub-Signature@ HTTP header's value.
  -> L.ByteString
     -- ^ Request body with JSON-encoded notifications.
  -> FacebookT Auth m (Maybe (RealTimeUpdateNotification a))
getRealTimeUpdateNotifications :: ByteString
-> ByteString
-> FacebookT Auth m (Maybe (RealTimeUpdateNotification a))
getRealTimeUpdateNotifications =
  ((Maybe ByteString -> Maybe (RealTimeUpdateNotification a))
-> FacebookT Auth m (Maybe ByteString)
-> FacebookT Auth m (Maybe (RealTimeUpdateNotification a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe ByteString
-> (ByteString -> Maybe (RealTimeUpdateNotification a))
-> Maybe (RealTimeUpdateNotification a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe (RealTimeUpdateNotification a)
forall a. FromJSON a => ByteString -> Maybe a
A.decode) (FacebookT Auth m (Maybe ByteString)
 -> FacebookT Auth m (Maybe (RealTimeUpdateNotification a)))
-> (ByteString -> FacebookT Auth m (Maybe ByteString))
-> ByteString
-> FacebookT Auth m (Maybe (RealTimeUpdateNotification a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((ByteString -> FacebookT Auth m (Maybe ByteString))
 -> ByteString
 -> FacebookT Auth m (Maybe (RealTimeUpdateNotification a)))
-> (ByteString
    -> ByteString -> FacebookT Auth m (Maybe ByteString))
-> ByteString
-> ByteString
-> FacebookT Auth m (Maybe (RealTimeUpdateNotification a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> FacebookT Auth m (Maybe ByteString)
forall (m :: * -> *).
(Monad m, MonadIO m) =>
ByteString -> ByteString -> FacebookT Auth m (Maybe ByteString)
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
    { RealTimeUpdateNotification a -> RealTimeUpdateObject
rtunObject :: RealTimeUpdateObject
    , RealTimeUpdateNotification a -> [a]
rtunEntries :: [a]
    }
  deriving (RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
(RealTimeUpdateNotification a
 -> RealTimeUpdateNotification a -> Bool)
-> (RealTimeUpdateNotification a
    -> RealTimeUpdateNotification a -> Bool)
-> Eq (RealTimeUpdateNotification a)
forall a.
Eq a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
$c/= :: forall a.
Eq a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
== :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
$c== :: forall a.
Eq a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
Eq, Eq (RealTimeUpdateNotification a)
Eq (RealTimeUpdateNotification a)
-> (RealTimeUpdateNotification a
    -> RealTimeUpdateNotification a -> Ordering)
-> (RealTimeUpdateNotification a
    -> RealTimeUpdateNotification a -> Bool)
-> (RealTimeUpdateNotification a
    -> RealTimeUpdateNotification a -> Bool)
-> (RealTimeUpdateNotification a
    -> RealTimeUpdateNotification a -> Bool)
-> (RealTimeUpdateNotification a
    -> RealTimeUpdateNotification a -> Bool)
-> (RealTimeUpdateNotification a
    -> RealTimeUpdateNotification a -> RealTimeUpdateNotification a)
-> (RealTimeUpdateNotification a
    -> RealTimeUpdateNotification a -> RealTimeUpdateNotification a)
-> Ord (RealTimeUpdateNotification a)
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Ordering
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> RealTimeUpdateNotification a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (RealTimeUpdateNotification a)
forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Ordering
forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> RealTimeUpdateNotification a
min :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> RealTimeUpdateNotification a
$cmin :: forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> RealTimeUpdateNotification a
max :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> RealTimeUpdateNotification a
$cmax :: forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> RealTimeUpdateNotification a
>= :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
$c>= :: forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
> :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
$c> :: forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
<= :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
$c<= :: forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
< :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
$c< :: forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Bool
compare :: RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Ordering
$ccompare :: forall a.
Ord a =>
RealTimeUpdateNotification a
-> RealTimeUpdateNotification a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (RealTimeUpdateNotification a)
Ord, Int -> RealTimeUpdateNotification a -> ShowS
[RealTimeUpdateNotification a] -> ShowS
RealTimeUpdateNotification a -> String
(Int -> RealTimeUpdateNotification a -> ShowS)
-> (RealTimeUpdateNotification a -> String)
-> ([RealTimeUpdateNotification a] -> ShowS)
-> Show (RealTimeUpdateNotification a)
forall a. Show a => Int -> RealTimeUpdateNotification a -> ShowS
forall a. Show a => [RealTimeUpdateNotification a] -> ShowS
forall a. Show a => RealTimeUpdateNotification a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RealTimeUpdateNotification a] -> ShowS
$cshowList :: forall a. Show a => [RealTimeUpdateNotification a] -> ShowS
show :: RealTimeUpdateNotification a -> String
$cshow :: forall a. Show a => RealTimeUpdateNotification a -> String
showsPrec :: Int -> RealTimeUpdateNotification a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RealTimeUpdateNotification a -> ShowS
Show, Typeable)

instance A.FromJSON a => A.FromJSON (RealTimeUpdateNotification a) where
  parseJSON :: Value -> Parser (RealTimeUpdateNotification a)
parseJSON (A.Object Object
v) =
    RealTimeUpdateObject -> [a] -> RealTimeUpdateNotification a
forall a.
RealTimeUpdateObject -> [a] -> RealTimeUpdateNotification a
RealTimeUpdateNotification (RealTimeUpdateObject -> [a] -> RealTimeUpdateNotification a)
-> Parser RealTimeUpdateObject
-> Parser ([a] -> RealTimeUpdateNotification a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser RealTimeUpdateObject
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"object" Parser ([a] -> RealTimeUpdateNotification a)
-> Parser [a] -> Parser (RealTimeUpdateNotification a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [a]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"entry"
  parseJSON Value
_ = Parser (RealTimeUpdateNotification a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | A notification for the 'UserRTUO' object.
data RealTimeUpdateNotificationUserEntry =
  RealTimeUpdateNotificationUserEntry
    { RealTimeUpdateNotificationUserEntry -> Id
rtuneUserId :: Id
    , RealTimeUpdateNotificationUserEntry -> [ByteString]
rtuneChangedFields :: [RealTimeUpdateField]
    , RealTimeUpdateNotificationUserEntry -> Integer
rtuneTime :: Integer
    }
  deriving (RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
(RealTimeUpdateNotificationUserEntry
 -> RealTimeUpdateNotificationUserEntry -> Bool)
-> (RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry -> Bool)
-> Eq RealTimeUpdateNotificationUserEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
$c/= :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
== :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
$c== :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
Eq, Eq RealTimeUpdateNotificationUserEntry
Eq RealTimeUpdateNotificationUserEntry
-> (RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry -> Ordering)
-> (RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry -> Bool)
-> (RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry -> Bool)
-> (RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry -> Bool)
-> (RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry -> Bool)
-> (RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry)
-> (RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry
    -> RealTimeUpdateNotificationUserEntry)
-> Ord RealTimeUpdateNotificationUserEntry
RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Ordering
RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
$cmin :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
max :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
$cmax :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry
>= :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
$c>= :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
> :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
$c> :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
<= :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
$c<= :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
< :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
$c< :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Bool
compare :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Ordering
$ccompare :: RealTimeUpdateNotificationUserEntry
-> RealTimeUpdateNotificationUserEntry -> Ordering
$cp1Ord :: Eq RealTimeUpdateNotificationUserEntry
Ord, Int -> RealTimeUpdateNotificationUserEntry -> ShowS
[RealTimeUpdateNotificationUserEntry] -> ShowS
RealTimeUpdateNotificationUserEntry -> String
(Int -> RealTimeUpdateNotificationUserEntry -> ShowS)
-> (RealTimeUpdateNotificationUserEntry -> String)
-> ([RealTimeUpdateNotificationUserEntry] -> ShowS)
-> Show RealTimeUpdateNotificationUserEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RealTimeUpdateNotificationUserEntry] -> ShowS
$cshowList :: [RealTimeUpdateNotificationUserEntry] -> ShowS
show :: RealTimeUpdateNotificationUserEntry -> String
$cshow :: RealTimeUpdateNotificationUserEntry -> String
showsPrec :: Int -> RealTimeUpdateNotificationUserEntry -> ShowS
$cshowsPrec :: Int -> RealTimeUpdateNotificationUserEntry -> ShowS
Show, Typeable)

instance A.FromJSON RealTimeUpdateNotificationUserEntry where
  parseJSON :: Value -> Parser RealTimeUpdateNotificationUserEntry
parseJSON (A.Object Object
v) =
    Id
-> [ByteString] -> Integer -> RealTimeUpdateNotificationUserEntry
RealTimeUpdateNotificationUserEntry (Id
 -> [ByteString] -> Integer -> RealTimeUpdateNotificationUserEntry)
-> Parser Id
-> Parser
     ([ByteString] -> Integer -> RealTimeUpdateNotificationUserEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Id
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"uid" Parser
  ([ByteString] -> Integer -> RealTimeUpdateNotificationUserEntry)
-> Parser [ByteString]
-> Parser (Integer -> RealTimeUpdateNotificationUserEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    ([Text] -> [ByteString]) -> Parser [Text] -> Parser [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ByteString
encodeUtf8) (Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"changed_fields") Parser (Integer -> RealTimeUpdateNotificationUserEntry)
-> Parser Integer -> Parser RealTimeUpdateNotificationUserEntry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"time"
  parseJSON Value
_ = Parser RealTimeUpdateNotificationUserEntry
forall (m :: * -> *) a. MonadPlus m => m a
mzero