fb 0.4.0.2 → 0.5
raw patch · 6 files changed
+82/−21 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Facebook: getUserLogoutUrl :: AccessToken User -> RedirectUrl -> Text
- Facebook: UserAccessToken :: AccessTokenData -> UTCTime -> AccessToken User
+ Facebook: UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken User
- Facebook: createAction :: ResourceIO m => Action -> [Argument] -> AccessToken User -> FacebookT Auth m Id
+ Facebook: createAction :: ResourceIO m => Action -> [Argument] -> Maybe (AccessToken App) -> AccessToken User -> FacebookT Auth m Id
Files
- fb.cabal +1/−1
- src/Facebook.hs +1/−0
- src/Facebook/Auth.hs +52/−11
- src/Facebook/OpenGraph.hs +13/−3
- src/Facebook/Types.hs +14/−5
- tests/runtests.hs +1/−1
fb.cabal view
@@ -1,5 +1,5 @@ name: fb-version: 0.4.0.2+version: 0.5 license: BSD3 license-file: LICENSE author: Felipe Lessa
src/Facebook.hs view
@@ -23,6 +23,7 @@ , Permission , getUserAccessTokenStep1 , getUserAccessTokenStep2+ , getUserLogoutUrl , extendUserAccessToken -- * Facebook's Open Graph API
src/Facebook/Auth.hs view
@@ -2,6 +2,7 @@ ( getAppAccessToken , getUserAccessTokenStep1 , getUserAccessTokenStep2+ , getUserLogoutUrl , extendUserAccessToken , RedirectUrl , Permission@@ -11,6 +12,8 @@ import Control.Applicative import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Aeson ((.:))+import Data.Aeson.Types (parseEither) import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Time (getCurrentTime, addUTCTime, UTCTime)@@ -25,7 +28,7 @@ import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE import qualified Network.HTTP.Conduit as H--- import qualified Network.HTTP.Types as HT+import qualified Network.HTTP.Types as HT import Facebook.Types@@ -83,12 +86,25 @@ getUserAccessTokenStep2 redirectUrl query = case query of [code@("code", _)] -> runResourceInFb $ do+ -- 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)] response <- fbhttp req- lift $ H.responseBody response C.$$ C.sinkParser (userAccessTokenParser now)+ preToken <- lift $ H.responseBody response C.$$+ C.sinkParser (userAccessTokenParser now)++ -- Get user's ID throught Facebook's graph.+ userInfo <- asJson =<< fbhttp (fbreq "/me" (Just preToken) [("fields", "id")])+ case (parseEither (.: "id") userInfo, preToken) of+ (Left str, _) ->+ E.throw $ FbLibraryException $ T.concat+ [ "getUserAccessTokenStep2: failed to get the UserId ("+ , T.pack str, ")" ]+ (Right (userId :: UserId), UserAccessToken _ d e) ->+ return (UserAccessToken userId d e)+ _ -> let [error_, errorReason, errorDescr] = map (fromMaybe "" . flip lookup query) ["error", "error_reason", "error_description"]@@ -98,18 +114,43 @@ -- | Attoparsec parser for user access tokens returned by--- Facebook as a query string.-userAccessTokenParser :: UTCTime -- 'getCurrentTime'+-- Facebook as a query string. Returns an user access token with+-- a broken 'UserId'.+userAccessTokenParser :: UTCTime -- ^ 'getCurrentTime' -> A.Parser (AccessToken User) userAccessTokenParser now =- UserAccessToken <$ A.string "access_token="- <*> A.takeWhile (/= '?')- <* A.string "&expires="- <*> (toExpire <$> A.decimal)- <* A.endOfInput+ UserAccessToken userId+ <$ A.string "access_token="+ <*> A.takeWhile (/= '?')+ <* A.string "&expires="+ <*> (toExpire <$> A.decimal)+ <* A.endOfInput where toExpire i = addUTCTime (fromIntegral (i :: Int)) now+ userId = error "userAccessTokenParser: never here" +-- | The URL an user should be redirected to in order to log them+-- out of their Facebook session. Facebook will then redirect+-- the user to the provided URL after logging them out. Note+-- that, at the time of this writing, Facebook's policies require+-- you to log the user out of Facebook when they ask to log out+-- of your site.+--+-- Note also that Facebook may refuse to redirect the user to the+-- provided URL if their user access token is invalid. In order+-- 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 :: AccessToken User -- ^ 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_) ]++ -- | URL where the user is redirected to after Facebook -- authenticates the user authorizes your application. This URL -- should be inside the domain registered for your Facebook@@ -161,7 +202,7 @@ then return False else let page = case token of- UserAccessToken _ _ -> "/me"+ UserAccessToken _ _ _ -> "/me" -- Documented way of checking if the token is valid, -- see <https://developers.facebook.com/blog/post/500/>. AppAccessToken _ -> "/19292868552"@@ -186,7 +227,7 @@ C.ResourceIO m => AccessToken User -> FacebookT Auth m (Either FacebookException (AccessToken User))-extendUserAccessToken token@(UserAccessToken data_ _)+extendUserAccessToken token@(UserAccessToken _ data_ _) = do expired <- hasExpired token if expired then return (Left hasExpiredExc) else tryToExtend where
src/Facebook/OpenGraph.hs view
@@ -43,11 +43,21 @@ createAction :: C.ResourceIO m => Action -- ^ Action kind to be created. -> [Argument] -- ^ Arguments of the action.- -> AccessToken User+ -> Maybe (AccessToken App)+ -- ^ Optional app access token (optional with+ -- respect to this library, since you can't make+ -- this mandatory by changing the settings of+ -- your action on Facebook).+ -> AccessToken User -- ^ User access token. -> FacebookT Auth m Id-createAction (Action action) query token = do+createAction (Action action) query mapptoken usertoken = do creds <- getCreds- postObject ("/me/" <> appName creds <> ":" <> action) query token+ let post :: C.ResourceIO m => Ascii -> AccessToken anyKind -> FacebookT Auth m Id+ post prepath = postObject (prepath <> appName creds <> ":" <> action) query+ case mapptoken of+ Nothing -> post "/me/" usertoken+ Just apptoken -> post ("/" <> accessTokenUserId usertoken <> "/") apptoken+ -- | An action of your app. Please refer to Facebook's
src/Facebook/Types.hs view
@@ -2,8 +2,10 @@ ( Credentials(..) , AccessToken(..) , AccessTokenData+ , UserId , accessTokenData , accessTokenExpires+ , accessTokenUserId , User , App , Argument@@ -44,7 +46,7 @@ -- These access tokens are distinguished by the phantom type on -- 'AccessToken', which can be 'User' or 'App'. data AccessToken kind where- UserAccessToken :: AccessTokenData -> UTCTime -> AccessToken User+ UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken User AppAccessToken :: AccessTokenData -> AccessToken App deriving instance Eq (AccessToken kind)@@ -56,16 +58,23 @@ -- calls. type AccessTokenData = Ascii +-- | A Facebook user id such as @1008905713901@.+type UserId = Ascii+ -- | Get the access token data. accessTokenData :: AccessToken kind -> AccessTokenData-accessTokenData (UserAccessToken d _) = d-accessTokenData (AppAccessToken d) = d+accessTokenData (UserAccessToken _ d _) = d+accessTokenData (AppAccessToken d) = d -- | Expire time of an access token. It may never expire, in -- which case it will be @Nothing@. accessTokenExpires :: AccessToken kind -> Maybe UTCTime-accessTokenExpires (UserAccessToken _ expt) = Just expt-accessTokenExpires (AppAccessToken _) = Nothing+accessTokenExpires (UserAccessToken _ _ expt) = Just expt+accessTokenExpires (AppAccessToken _) = Nothing++-- | Get the user ID of an user access token.+accessTokenUserId :: AccessToken User -> UserId+accessTokenUserId (UserAccessToken uid _ _) = uid -- | Phantom type used mark an 'AccessToken' as an user access -- token.
tests/runtests.hs view
@@ -63,7 +63,7 @@ invalidCredentials = FB.Credentials "this" "isn't" "valid" invalidUserAccessToken :: FB.AccessToken FB.User-invalidUserAccessToken = FB.UserAccessToken "invalid" farInTheFuture+invalidUserAccessToken = FB.UserAccessToken "invalid" "user" farInTheFuture where Just farInTheFuture = parseTime (error "farInTheFuture") "%Y" "3000" -- It's actually important to use 'farInTheFuture' since we