diff --git a/fb.cabal b/fb.cabal --- a/fb.cabal +++ b/fb.cabal @@ -1,5 +1,5 @@ name: fb -version: 0.12.9 +version: 0.13 license: BSD3 license-file: LICENSE author: Felipe Lessa @@ -63,7 +63,6 @@ base >= 4 && < 5 , lifted-base >= 0.1 && < 0.2 , bytestring >= 0.9 && < 0.11 - , bytestring-lexing == 0.4.* , text >= 0.11 && < 0.12 , transformers >= 0.2 && < 0.4 , transformers-base diff --git a/src/Facebook/Auth.hs b/src/Facebook/Auth.hs --- a/src/Facebook/Auth.hs +++ b/src/Facebook/Auth.hs @@ -31,12 +31,14 @@ import qualified Control.Exception.Lifted as E import qualified Data.Aeson as AE import qualified Data.Aeson.Types as AE -import qualified Data.Attoparsec.Char8 as A +import qualified Data.Attoparsec.Char8 as AB +import qualified Data.Attoparsec.Text as A import qualified Data.ByteString as B import qualified Data.ByteString.Base64.URL as Base64URL import qualified Data.ByteString.Char8 as B8 import qualified Data.Conduit as C import qualified Data.Conduit.Attoparsec as C +import qualified Data.Conduit.Text as CT import qualified Data.List as L import qualified Data.Serialize as Cereal import qualified Data.Text as T @@ -63,8 +65,9 @@ response <- fbhttp req lift $ H.responseBody response C.$$+- + CT.decode CT.utf8 C.=$ C.sinkParser (AppAccessToken <$ A.string "access_token=" - <*> A.takeByteString) + <*> A.takeText) -- | The first step to get an user access token. Returns the @@ -82,7 +85,7 @@ Production -> "https://www.facebook.com/dialog/oauth?client_id=" Beta -> "https://www.beta.facebook.com/dialog/oauth?client_id=" in T.concat $ urlBase - : TE.decodeUtf8 (appId creds) + : appId creds : "&redirect_uri=" : redirectUrl : (case perms of @@ -140,11 +143,12 @@ userAccessTokenParser now bs = let q = HT.parseQuery bs; lookup' a = join (lookup a q) in case (,) <$> lookup' "access_token" <*> lookup' "expires" of - (Just (tok, expt)) -> UserAccessToken userId tok (toExpire expt) + (Just (tok, expt)) -> UserAccessToken userId (dec tok) (toExpire expt) _ -> error $ "userAccessTokenParser: failed to parse " ++ show bs where toExpire expt = let i = read (B8.unpack expt) :: Int in addUTCTime (fromIntegral i) now userId = error "userAccessTokenParser: never here" + dec = TE.decodeUtf8With TE.lenientDecode -- | The URL an user should be redirected to in order to log them @@ -178,7 +182,7 @@ in TE.decodeUtf8 $ urlBase <> HT.renderQuery False [ ("next", Just (TE.encodeUtf8 next)) - , ("access_token", Just data_) ] + , ("access_token", Just (TE.encodeUtf8 data_)) ] -- | URL where the user is redirected to after Facebook @@ -274,7 +278,7 @@ creds <- getCreds req <- fbreq "/oauth/access_token" Nothing $ tsq creds [ ("grant_type", "fb_exchange_token") - , ("fb_exchange_token", data_) ] + , ("fb_exchange_token", TE.encodeUtf8 data_) ] eresponse <- E.try (asBS =<< fbhttp req) case eresponse of Right response -> do @@ -304,7 +308,7 @@ ('.', encodedUnparsedPayload) <- MaybeT $ return (B8.uncons encodedUnparsedPayloadWithDot) signature <- eitherToMaybeT $ Base64URL.decode $ addBase64Padding encodedSignature unparsedPayload <- eitherToMaybeT $ Base64URL.decode $ addBase64Padding encodedUnparsedPayload - payload <- eitherToMaybeT $ A.parseOnly json' unparsedPayload + payload <- eitherToMaybeT $ AB.parseOnly json' unparsedPayload -- Verify signature SignedRequestAlgorithm algo <- fromJson payload @@ -321,7 +325,7 @@ fromJson :: (AE.FromJSON a, Monad m) => AE.Value -> MaybeT m a fromJson = eitherToMaybeT . AE.parseEither AE.parseJSON credsToHmacKey :: Credentials -> MacKey ctx SHA256 - credsToHmacKey = MacKey . appSecret + credsToHmacKey = MacKey . appSecretBS newtype SignedRequestAlgorithm = SignedRequestAlgorithm Text instance AE.FromJSON SignedRequestAlgorithm where diff --git a/src/Facebook/Base.hs b/src/Facebook/Base.hs --- a/src/Facebook/Base.hs +++ b/src/Facebook/Base.hs @@ -27,6 +27,7 @@ import qualified Data.Conduit.Attoparsec as C import qualified Data.Conduit.List as CL import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified Network.HTTP.Conduit as H import qualified Network.HTTP.Types as HT @@ -43,7 +44,7 @@ -- | A plain 'H.Request' to a Facebook API. Use this instead of -- 'H.def' when creating new 'H.Request'@s@ for Facebook. fbreq :: Monad m => - ByteString -- ^ Path. + Text -- ^ Path. -> Maybe (AccessToken anyKind) -- ^ Access token. -> HT.SimpleQuery -- ^ Parameters. -> FacebookT anyAuth m (H.Request n) @@ -55,11 +56,12 @@ in H.def { H.secure = True , H.host = host , H.port = 443 - , H.path = path + , H.path = TE.encodeUtf8 path , H.redirectCount = 3 , H.queryString = HT.renderSimpleQuery False $ maybe id tsq mtoken query + , H.responseTimeout = Just 120000000 -- 2 minutes } @@ -72,11 +74,11 @@ tsq _ = id instance ToSimpleQuery Credentials where - tsq creds = (:) ("client_id", appId creds) . - (:) ("client_secret", appSecret creds) + tsq creds = (:) ("client_id", appIdBS creds) . + (:) ("client_secret", appSecretBS creds) instance ToSimpleQuery (AccessToken anyKind) where - tsq token = (:) ("access_token", accessTokenData token) + tsq token = (:) ("access_token", TE.encodeUtf8 $ accessTokenData token) -- | Converts a plain 'H.Response' coming from 'H.http' into a diff --git a/src/Facebook/Graph.hs b/src/Facebook/Graph.hs --- a/src/Facebook/Graph.hs +++ b/src/Facebook/Graph.hs @@ -1,7 +1,6 @@ {-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts, OverloadedStrings #-} module Facebook.Graph - ( Id(..) - , getObject + ( getObject , postObject , searchObjects , Pager(..) @@ -24,10 +23,8 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Resource (MonadResourceBase) import Data.ByteString.Char8 (ByteString) -import Data.ByteString.Lex.Integral (packDecimal) import Data.Int (Int8, Int16, Int32, Int64) import Data.List (intersperse) -import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Typeable (Typeable) import Data.Word (Word, Word8, Word16, Word32, Word64) @@ -51,21 +48,9 @@ import Facebook.Types --- | The identification code of an object. -newtype Id = Id { idCode :: ByteString } - deriving (Eq, Ord, Show, Read, Typeable) - -instance A.FromJSON Id where - parseJSON (A.Object v) = v A..: "id" - parseJSON (A.String s) = pure $ Id $ TE.encodeUtf8 s - parseJSON (A.Number d) = pure $ Id $ from $ floor d - where from i = fromMaybe (B.pack $ show i) (packDecimal (i :: Int64)) - parseJSON o = fail $ "Can't parse Facebook.Id from " ++ show o - - -- | 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 @\/@) + Text -- ^ Path (should begin with a slash @\/@) -> [Argument] -- ^ Arguments to be passed to Facebook -> Maybe (AccessToken anyKind) -- ^ Optional access token -> FacebookT anyAuth m a @@ -76,7 +61,7 @@ -- | 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 @\/@) + Text -- ^ Path (should begin with a slash @\/@) -> [Argument] -- ^ Arguments to be passed to Facebook -> AccessToken anyKind -- ^ Access token -> FacebookT Auth m a @@ -89,13 +74,13 @@ -- | Make a raw @GET@ request to the /search endpoint of Facebook’s -- Graph API. Returns a raw JSON 'A.Value'. searchObjects :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) - => ByteString -- ^ A Facebook object type to search for - -> ByteString -- ^ The keyword to search for + => Text -- ^ A Facebook object type to search for + -> Text -- ^ The keyword to search for -> [Argument] -- ^ Additional arguments to pass -> Maybe UserAccessToken -- ^ Optional access token -> FacebookT anyAuth m (Pager a) searchObjects objectType keyword query = getObject "/search" query' - where query' = ("q", keyword) : ("type", objectType) : query + where query' = ("q" #= keyword) : ("type" #= objectType) : query ---------------------------------------------------------------------- @@ -281,7 +266,7 @@ -- | An object's 'Id' code. instance SimpleType Id where - encodeFbParam = idCode + encodeFbParam = TE.encodeUtf8 . idCode -- | 'Permission' is a @newtype@ of 'Text' instance SimpleType Permission where diff --git a/src/Facebook/Object/Action.hs b/src/Facebook/Object/Action.hs --- a/src/Facebook/Object/Action.hs +++ b/src/Facebook/Object/Action.hs @@ -6,9 +6,9 @@ import Control.Arrow (first) import Control.Monad.Trans.Control (MonadBaseControl) -import Data.ByteString.Char8 (ByteString) import Data.Function (on) import Data.String (IsString(..)) +import Data.Text (Text) import qualified Data.Conduit as C @@ -37,11 +37,11 @@ -> FacebookT Auth m Id createAction (Action action) query mapptoken usertoken = do creds <- getCreds - let post :: (C.MonadResource m, MonadBaseControl IO m) => ByteString -> AccessToken anyKind -> FacebookT Auth m Id + let post :: (C.MonadResource m, MonadBaseControl IO m) => Text -> 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 + Just apptoken -> post ("/" <> idCode (accessTokenUserId usertoken) <> "/") apptoken -- | An action of your app. Please refer to Facebook's @@ -49,7 +49,7 @@ -- -- to see how you can create actions. -- --- This is a @newtype@ of 'ByteString' that supports only 'IsString'. +-- This is a @newtype@ of 'Text' that supports only 'IsString'. -- This means that to create an 'Action' you should use the -- @OverloadedStrings@ language extension. For example, -- @@ -58,7 +58,7 @@ -- > foo token = do -- > ... -- > createAction "cook" [...] token -newtype Action = Action { unAction :: ByteString } +newtype Action = Action { unAction :: Text } instance Show Action where show = show . unAction diff --git a/src/Facebook/Object/Checkin.hs b/src/Facebook/Object/Checkin.hs --- a/src/Facebook/Object/Checkin.hs +++ b/src/Facebook/Object/Checkin.hs @@ -72,7 +72,7 @@ -> [Argument] -- ^ Arguments to be passed to Facebook. -> Maybe UserAccessToken -- ^ Optional user access token. -> FacebookT anyAuth m Checkin -getCheckin (Id id_) query mtoken = getObject ("/" <> id_) query mtoken +getCheckin id_ query mtoken = getObject ("/" <> idCode id_) query mtoken -- | Creates a 'check-in' and returns its ID. Place and diff --git a/src/Facebook/Object/Page.hs b/src/Facebook/Object/Page.hs --- a/src/Facebook/Object/Page.hs +++ b/src/Facebook/Object/Page.hs @@ -12,7 +12,6 @@ import Control.Monad (mzero) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson ((.:), (.:?)) -import Data.ByteString.Char8 (ByteString) import qualified Data.Aeson as A import qualified Data.Conduit as C import Data.Text (Text) @@ -27,9 +26,9 @@ -- -- /NOTE:/ Does not yet support all fields. Please file an issue if -- you need any other fields. -data Page = Page { pageId :: ByteString +data Page = Page { pageId :: Id , pageName :: Maybe Text - , pageLink :: Maybe ByteString + , pageLink :: Maybe Text , pageCategory :: Maybe Text , pageIsPublished :: Maybe Bool , pageCanPost :: Maybe Bool @@ -37,8 +36,8 @@ , pageLocation :: Maybe Location , pagePhone :: Maybe Text , pageCheckins :: Maybe Integer - , pagePicture :: Maybe ByteString - , pageWebsite :: Maybe ByteString + , pagePicture :: Maybe Text + , pageWebsite :: Maybe Text , pageTalkingAboutCount :: Maybe Integer } deriving (Eq, Ord, Show, Read, Typeable) @@ -62,16 +61,16 @@ -- | Get a page using its ID. The user access token is optional. getPage :: (C.MonadResource m, MonadBaseControl IO m) - => ByteString -- ^ Page ID + => Id -- ^ Page ID -> [Argument] -- ^ Arguments to be passed to Facebook -> Maybe UserAccessToken -- ^ Optional user access token -> FacebookT anyAuth m Page -getPage id_ = getObject $ "/" <> id_ +getPage id_ = getObject $ "/" <> idCode id_ -- | Search pages by keyword. The user access token is optional. searchPages :: (C.MonadResource m, MonadBaseControl IO m) - => ByteString -- ^ Keyword to search for + => Text -- ^ Keyword to search for -> [Argument] -- ^ Arguments to pass to Facebook -> Maybe UserAccessToken -- ^ Optional user access token -> FacebookT anyAuth m (Pager Page) diff --git a/src/Facebook/Object/User.hs b/src/Facebook/Object/User.hs --- a/src/Facebook/Object/User.hs +++ b/src/Facebook/Object/User.hs @@ -11,14 +11,12 @@ import Control.Monad (mzero) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson ((.:), (.:?)) -import Data.ByteString.Char8 (ByteString) import Data.Text (Text) import Data.Typeable (Typeable) -- import qualified Control.Exception.Lifted as E import qualified Data.Aeson as A import qualified Data.Conduit as C --- import qualified Data.Text as T import Facebook.Types @@ -90,12 +88,12 @@ -> [Argument] -- ^ Arguments to be passed to Facebook. -> Maybe UserAccessToken -- ^ Optional user access token. -> FacebookT anyAuth m User -getUser id_ query mtoken = getObject ("/" <> id_) query mtoken +getUser id_ query mtoken = getObject ("/" <> idCode id_) query mtoken -- | Search users by keyword. searchUsers :: (C.MonadResource m, MonadBaseControl IO m) - => ByteString + => Text -> [Argument] -> Maybe UserAccessToken -> FacebookT anyAuth m (Pager User) @@ -110,4 +108,4 @@ -> UserAccessToken -- ^ User access token. -> FacebookT anyAuth m (Pager Checkin) getUserCheckins id_ query token = - getObject ("/" <> id_ <> "/checkins") query (Just token) + getObject ("/" <> idCode id_ <> "/checkins") query (Just token) diff --git a/src/Facebook/RealTime.hs b/src/Facebook/RealTime.hs --- a/src/Facebook/RealTime.hs +++ b/src/Facebook/RealTime.hs @@ -25,10 +25,10 @@ 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.Conduit.List as CL +import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Network.HTTP.Conduit as H import qualified Network.HTTP.Types as HT @@ -118,10 +118,10 @@ -- | (Internal) Get the subscription's path. -getSubscriptionsPath :: Monad m => FacebookT Auth m ByteString +getSubscriptionsPath :: Monad m => FacebookT Auth m Text getSubscriptionsPath = do creds <- getCreds - return $ B.concat ["/", appId creds, "/subscriptions"] + return $ T.concat ["/", appId creds, "/subscriptions"] -- | Information returned by Facebook about a real-time update @@ -172,7 +172,7 @@ verifyRealTimeUpdateNotifications sig body = do creds <- getCreds let key :: Crypto.MacKey SHA1.Ctx SHA1.SHA1 - key = Crypto.MacKey (appSecret creds) + key = Crypto.MacKey (appSecretBS creds) hash = Crypto.hmac key body expected = "sha1=" <> Base16.encode (Crypto.encode hash) return $! if sig `Crypto.constTimeEq` expected then Just body else Nothing diff --git a/src/Facebook/TestUsers.hs b/src/Facebook/TestUsers.hs --- a/src/Facebook/TestUsers.hs +++ b/src/Facebook/TestUsers.hs @@ -123,7 +123,7 @@ -> AppAccessToken -- ^ Access token for your app. -> FacebookT Auth m Bool removeTestUser testUser token = - getObjectBool ("/" <> tuId testUser) [("method","delete")] (Just token) + getObjectBool ("/" <> idCode (tuId testUser)) [("method","delete")] (Just token) -- | Make a friend connection between two test users. @@ -146,7 +146,7 @@ \ a token. Both users must have a token." makeFriendConn (TestUser {tuId = id1, tuAccessToken = (Just token1)}) (TestUser {tuId = id2, tuAccessToken = (Just token2)}) = do let friendReq userId1 userId2 token = - getObjectBool ("/" <> userId1 <> "/friends/" <> userId2) + getObjectBool ("/" <> idCode userId1 <> "/friends/" <> idCode userId2) [ "method" #= ("post" :: B.ByteString), "access_token" #= token ] Nothing @@ -170,7 +170,7 @@ -- as a JSON, it tries to parse either as "true" or "false". -- Used only by the Test User API bindings. getObjectBool :: (C.MonadResource m, MonadBaseControl IO m) - => B.ByteString + => Text -- ^ Path (should begin with a slash @\/@). -> [Argument] -- ^ Arguments to be passed to Facebook. diff --git a/src/Facebook/Types.hs b/src/Facebook/Types.hs --- a/src/Facebook/Types.hs +++ b/src/Facebook/Types.hs @@ -1,10 +1,13 @@ {-# LANGUAGE DeriveDataTypeable, GADTs, StandaloneDeriving #-} module Facebook.Types ( Credentials(..) + , appIdBS + , appSecretBS , AccessToken(..) , UserAccessToken , AppAccessToken , AccessTokenData + , Id(..) , UserId , accessTokenData , accessTokenExpires @@ -16,26 +19,41 @@ , FbUTCTime(..) ) where +import Control.Applicative (pure) import Data.ByteString (ByteString) +import Data.Int (Int64) import Data.Monoid (Monoid, mappend) +import Data.Text (Text) import Data.Time (UTCTime, parseTime) import Data.Typeable (Typeable, Typeable1) import System.Locale (defaultTimeLocale) import qualified Data.Aeson as A import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TLB +import qualified Data.Text.Lazy.Builder.Int as TLBI -- | Credentials that you get for your app when you register on -- Facebook. data Credentials = - Credentials { appName :: ByteString -- ^ Your application name (e.g. for Open Graph calls). - , appId :: ByteString -- ^ Your application ID. - , appSecret :: ByteString -- ^ Your application secret key. + Credentials { appName :: Text -- ^ Your application name (e.g. for Open Graph calls). + , appId :: Text -- ^ Your application ID. + , appSecret :: Text -- ^ Your application secret key. } deriving (Eq, Ord, Show, Read, Typeable) +-- | 'appId' for 'ByteString'. +appIdBS :: Credentials -> ByteString +appIdBS = TE.encodeUtf8 . appId +-- | 'appSecret' for 'ByteString'. +appSecretBS :: Credentials -> ByteString +appSecretBS = TE.encodeUtf8 . appSecret + + -- | An access token. While you can make some API calls without -- an access token, many require an access token and some will -- give you more information with an appropriate access token. @@ -69,12 +87,26 @@ deriving instance Show (AccessToken kind) deriving instance Typeable1 AccessToken + -- | The access token data that is passed to Facebook's API -- calls. -type AccessTokenData = ByteString +type AccessTokenData = Text --- | A Facebook user id such as @1008905713901@. -type UserId = ByteString +-- | The identification code of an object. +newtype Id = Id { idCode :: Text } + deriving (Eq, Ord, Show, Read, Typeable) + +instance A.FromJSON Id where + parseJSON (A.Object v) = v A..: "id" + parseJSON (A.String s) = pure $ Id s + parseJSON (A.Number d) = pure $ Id $ from $ floor d + where from i = TL.toStrict $ TLB.toLazyText $ TLBI.decimal (i :: Int64) + parseJSON o = fail $ "Can't parse Facebook.Id from " ++ show o + + +-- | A Facebook user ID such as @1008905713901@. +type UserId = Id + -- | Get the access token data. accessTokenData :: AccessToken anyKind -> AccessTokenData diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -50,7 +50,7 @@ where tryToGet = do [appName, appId, appSecret] <- mapM getEnv ["APP_NAME", "APP_ID", "APP_SECRET"] - return $ FB.Credentials (B.pack appName) (B.pack appId) (B.pack appSecret) + return $ FB.Credentials (T.pack appName) (T.pack appId) (T.pack appSecret) showHelp exc | not (isDoesNotExistError exc) = E.throw exc showHelp _ = do @@ -80,7 +80,7 @@ invalidCredentials = FB.Credentials "this" "isn't" "valid" invalidUserAccessToken :: FB.UserAccessToken -invalidUserAccessToken = FB.UserAccessToken "invalid" "user" farInTheFuture +invalidUserAccessToken = FB.UserAccessToken (FB.Id "invalid") "user" farInTheFuture where Just farInTheFuture = parseTime (error "farInTheFuture") "%Y" "3000" -- It's actually important to use 'farInTheFuture' since we @@ -95,7 +95,6 @@ main = H.withManager $ \manager -> liftIO $ do creds <- getCredentials hspec $ do -{- -- Run the tests twice, once in Facebook's production tier... facebookTests "Production tier: " manager @@ -106,7 +105,7 @@ manager (C.runResourceT . FB.beta_runFacebookT creds manager) (C.runResourceT . FB.beta_runNoAuthFacebookT manager) --} + -- Tests that don't depend on which tier is chosen. libraryTests manager @@ -153,8 +152,8 @@ describe' "getUser" $ do it "works for Zuckerberg" $ do runNoAuth $ do - user <- FB.getUser "zuck" [] Nothing - FB.userId user &?= "4" + user <- FB.getUser (FB.Id "zuck") [] Nothing + FB.userId user &?= FB.Id "4" FB.userName user &?= Just "Mark Zuckerberg" FB.userFirstName user &?= Just "Mark" FB.userMiddleName user &?= Nothing @@ -164,8 +163,8 @@ describe' "getPage" $ do it "works for FB Developers" $ do runNoAuth $ do - page <- FB.getPage "19292868552" [] Nothing - FB.pageId page &?= "19292868552" + page <- FB.getPage (FB.Id "19292868552") [] Nothing + FB.pageId page &?= (FB.Id "19292868552") FB.pageName page &?= Just "Facebook Developers" FB.pageCategory page &?= Just "Product/service" FB.pageIsPublished page &?= Just True @@ -347,7 +346,7 @@ prop "works for Id" $ \i -> let toId :: Int -> FB.Id - toId = FB.Id . B.pack . show + toId = FB.Id . T.pack . show j = abs i in FB.encodeFbParam (toId j) == FB.encodeFbParam j