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 master => YesodFacebook master where
fbCredentials :: master -> FB.Credentials
fbHttpManager :: master -> HTTP.Manager
fbUseBetaTier :: master -> Bool
fbUseBetaTier _ = False
getFbCredentials :: YesodFacebook master =>
Y.GHandler sub master FB.Credentials
getFbCredentials = fbCredentials <$> Y.getYesod
runYesodFbT ::
YesodFacebook master =>
FB.FacebookT FB.Auth (Y.GHandler sub master) a
-> Y.GHandler sub master a
runYesodFbT act = do
master <- Y.getYesod
let creds = fbCredentials master
manager = fbHttpManager master
(if fbUseBetaTier master
then FB.beta_runFacebookT
else FB.runFacebookT) creds manager act
runNoAuthYesodFbT ::
YesodFacebook master =>
FB.FacebookT FB.NoAuth (Y.GHandler sub master) a
-> Y.GHandler sub master a
runNoAuthYesodFbT act = do
master <- Y.getYesod
let manager = fbHttpManager master
(if fbUseBetaTier master
then FB.runNoAuthFacebookT
else FB.beta_runNoAuthFacebookT) manager act
parseRealTimeUpdateNotifications ::
(YesodFacebook master, A.FromJSON a) =>
Y.GHandler sub master (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.lift (W.requestBody waiReq 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 ::
FB.RealTimeUpdateToken
-> Y.GHandler sub master 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.GHandler sub master (Maybe [FB.Id])
lookupRequestIds = (map FB.Id . T.splitOn ",") <$$> Y.lookupGetParam "request_ids"
where (<$$>) = fmap . fmap