module Yesod.Facebook
(
YesodFacebook(..)
, runYesodFbT
, runNoAuthYesodFbT
, getFbCredentials
, parseRealTimeUpdateNotifications
, answerRealTimeUpdateChallenge
, lookupRequestIds
) where
import Control.Applicative ((<$>))
import Crypto.Classes (constTimeEq)
import Data.ByteString.Char8 ()
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Facebook as FB
import qualified Network.Wai as W
import qualified Network.HTTP.Conduit as HTTP
import qualified Yesod.Core as Y
class Y.Yesod site => YesodFacebook site where
fbCredentials :: site -> FB.Credentials
fbHttpManager :: site -> HTTP.Manager
fbUseBetaTier :: site -> Bool
fbUseBetaTier _ = False
getFbCredentials :: (Y.MonadHandler m, Y.HandlerSite m ~ site, YesodFacebook site) =>
m FB.Credentials
getFbCredentials = fbCredentials <$> Y.getYesod
runYesodFbT ::
(Y.MonadHandler m, Y.HandlerSite m ~ site, YesodFacebook site) =>
FB.FacebookT FB.Auth m a -> m a
runYesodFbT act = do
site <- Y.getYesod
let creds = fbCredentials site
manager = fbHttpManager site
(if fbUseBetaTier site
then FB.beta_runFacebookT
else FB.runFacebookT) creds manager act
runNoAuthYesodFbT ::
(Y.MonadHandler m, Y.HandlerSite m ~ site, YesodFacebook site) =>
FB.FacebookT FB.NoAuth m a -> m a
runNoAuthYesodFbT act = do
site <- Y.getYesod
let manager = fbHttpManager site
(if fbUseBetaTier site
then FB.runNoAuthFacebookT
else FB.beta_runNoAuthFacebookT) manager act
parseRealTimeUpdateNotifications ::
(Y.MonadHandler m, Y.HandlerSite m ~ site, YesodFacebook site, A.FromJSON a) =>
m (FB.RealTimeUpdateNotification a)
parseRealTimeUpdateNotifications = do
let myFail = fail . ("parseRealTimeUpdateNotifications: " ++)
waiReq <- Y.waiRequest
case lookup "X-Hub-Signature" (W.requestHeaders waiReq) of
Nothing -> myFail "X-Hub-Signature not found."
Just sig -> do
uncheckedData <- L.fromChunks <$> (Y.rawRequestBody C.$$ CL.consume)
mcheckedData <- runYesodFbT $ FB.verifyRealTimeUpdateNotifications sig uncheckedData
case mcheckedData of
Nothing -> myFail "Signature is invalid."
Just checkedData ->
case A.decode checkedData of
Nothing -> myFail "Could not decode data."
Just ret -> return ret
answerRealTimeUpdateChallenge ::
Y.MonadHandler m =>
FB.RealTimeUpdateToken
-> m Y.RepPlain
answerRealTimeUpdateChallenge token = do
mhubMode <- Y.lookupGetParam "hub.mode"
mhubChallenge <- Y.lookupGetParam "hub.challenge"
mhubVerifyToken <- Y.lookupGetParam "hub.verify_token"
case (mhubMode, mhubChallenge, mhubVerifyToken) of
(Just "subscribe", Just hubChallenge, Just hubVerifyToken)
| TE.encodeUtf8 hubVerifyToken `constTimeEq` token ->
return $ Y.RepPlain (Y.toContent hubChallenge)
_ -> Y.notFound
lookupRequestIds :: Y.MonadHandler m => m (Maybe [FB.Id])
lookupRequestIds = (map FB.Id . T.splitOn ",") <$$> Y.lookupGetParam "request_ids"
where (<$$>) = fmap . fmap