fb 1.2.1 → 2.0.0

raw patch · 13 files changed

+835/−735 lines, 13 filesdep +cryptonitedep +memorydep −base16-bytestringdep −base64-bytestringdep −cerealdep ~attoparsecdep ~bytestringdep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: cryptonite, memory

Dependencies removed: base16-bytestring, base64-bytestring, cereal, crypto-api, cryptohash, cryptohash-cryptoapi, old-locale

Dependency ranges changed: attoparsec, bytestring, text, transformers, unliftio-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• README.md +1/−0
• fb.cabal +14/−19
• src/Facebook.hs +16/−11
• src/Facebook/Auth.hs +163/−160
• src/Facebook/Base.hs +15/−31
• src/Facebook/Monad.hs +130/−59
• src/Facebook/Object/Action.hs +2/−1
• src/Facebook/Object/Page.hs +1/−1
• src/Facebook/RealTime.hs +57/−54
• src/Facebook/TestUsers.hs +4/−3
• src/Facebook/Types.hs +29/−0
• tests/Main.hs +383/−396

@@ -1,3 +1,23 @@+# Version 2.0.0++* Remove following dependency:+  - base16-bytestring+  - base64-bytestring+  - cereal+  - crypto-api+  - cryptohash+  - cryptohash-cryptoapi+  - old-locale+* Introduce new dependency:+  - cryptonite+  - memory+* Add new function setApiVersion+* Add Graph API version parameter. Avoid hardcoded `v2.8`.+* Expose setApiVersion and getApiVersion function+* Default API endpoint updated to `v3.2`+* Add appsecret_proof verification.+* Fix appsecret_proof verification encoding.+ # Version 1.2.1  * Make it work for ghc-8.4. See [#3](https://github.com/psibi/fb/issues/3)

@@ -30,6 +30,7 @@   { appName = "Your_APP_Name"   , appId = "your_app_id"   , appSecret = "xxxxxxxxxxxxxxxxx"+  , appSecretProof = False   }  main :: IO ()

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.21.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 1f1f3544be4d2d1dbdab5e0286e45bc861f216f4b24d04227e926c4cc51ab272+-- hash: 1165a61ce7ffe062813385420ff4c80c2e0089e64221cfd0d045a3cf1654b8a8  name:           fb-version:        1.2.1+version:        2.0.0 synopsis:       Bindings to Facebook's API. description:    This package exports bindings to Facebook's APIs (see                 <http://developers.facebook.com/>).  Does not have any external@@ -29,14 +31,12 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10- extra-source-files:-    CHANGELOG.md-    example.hs-    README.md     tests/Main.hs     tests/tryIt.hs+    example.hs+    README.md+    CHANGELOG.md  source-repository head   type: git@@ -72,27 +72,22 @@   ghc-options: -Wall   build-depends:       aeson >=0.8.0.2-    , attoparsec >=0.10.4 && <0.14+    , attoparsec >=0.10.4     , base >=4 && <5-    , base16-bytestring >=0.1-    , base64-bytestring >=0.1.1-    , bytestring >=0.9 && <0.11-    , cereal >=0.3 && <0.6+    , bytestring >=0.9     , conduit >=1.3.0     , conduit-extra >=1.3.0-    , crypto-api >=0.11 && <0.14-    , cryptohash >=0.7-    , cryptohash-cryptoapi ==0.1.*+    , cryptonite     , data-default     , http-client >=0.4.30     , http-conduit >=2.3.0     , http-types+    , memory     , monad-logger >=0.3.28-    , old-locale     , resourcet >=1.2.0-    , text >=0.11 && <1.3+    , text >=0.11     , time >=1.4-    , transformers >=0.2 && <0.6+    , transformers >=0.2     , transformers-base     , unliftio     , unliftio-core

@@ -1,7 +1,7 @@ module Facebook-  (-   -- * @FacebookT@ monad transformer-   FacebookT+  ( +    -- * @FacebookT@ monad transformer+    FacebookT   , runFacebookT   , runNoAuthFacebookT   , mapFacebookT@@ -17,8 +17,11 @@   , UserAccessToken   , AppAccessToken   , AccessTokenData+  , ApiVersion   , hasExpired   , isValid+  , setApiVersion+  , getApiVersion    -- ** App access token   , AppKind   , getAppAccessToken@@ -34,6 +37,8 @@   , DebugToken(..)    -- ** Signed requests   , parseSignedRequest+  , addAppSecretProof+  , makeAppSecretProof    -- * Facebook's Graph API    -- ** User   , User(..)@@ -126,18 +131,18 @@   , unPermission   ) where -import Facebook.Types-import Facebook.Monad-import Facebook.Base import Facebook.Auth-import Facebook.Pager+import Facebook.Base+import Facebook.FQL import Facebook.Graph-import Facebook.Object.Page-import Facebook.Object.User+import Facebook.Monad import Facebook.Object.Action import Facebook.Object.Checkin-import Facebook.Object.Order import Facebook.Object.FriendList+import Facebook.Object.Order+import Facebook.Object.Page+import Facebook.Object.User+import Facebook.Pager import Facebook.RealTime-import Facebook.FQL import Facebook.TestUsers+import Facebook.Types

@@ -22,58 +22,56 @@ #if __GLASGOW_HASKELL__ <= 784 import Control.Applicative #endif-import Control.Monad (guard, liftM, mzero)-import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad (guard, mzero)+import Control.Monad.IO.Class import Control.Monad.Trans.Maybe (MaybeT(..))-import Crypto.Classes (constTimeEq)-import Crypto.Hash.CryptoAPI (SHA256)-import Crypto.HMAC (hmac', MacKey(..))-import Data.Aeson ((.:))-import Data.Aeson.Parser (json')-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import Data.Time (getCurrentTime, addUTCTime, UTCTime)-import Data.Typeable (Typeable)-import Data.String (IsString(..))--import qualified UnliftIO.Exception as E import qualified Control.Monad.Trans.Resource as R+import Crypto.Hash.Algorithms (SHA256)+import Crypto.MAC.HMAC (HMAC(..), hmac)+import Data.Aeson ((.:)) import qualified Data.Aeson as AE+import Data.Aeson.Parser (json') import qualified Data.Aeson.Types as AE import qualified Data.Attoparsec.ByteString.Char8 as AB+import Data.ByteArray (ScrubbedBytes, convert)+import Data.ByteArray.Encoding (Base(..), convertFromBase) import qualified Data.ByteString as B-import qualified Data.ByteString.Base64.URL as Base64URL import qualified Data.ByteString.Char8 as B8 import qualified Data.List as L-import qualified Data.Serialize as Cereal+import Data.Maybe (fromMaybe)+import Data.String (IsString(..))+import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE+import Data.Time (UTCTime, addUTCTime, getCurrentTime)+import Data.Typeable (Typeable) import qualified Network.HTTP.Types as HT+import qualified UnliftIO.Exception as E -import Facebook.Types import Facebook.Base import Facebook.Monad+import Facebook.Types  -- | Get an app access token from Facebook using your -- credentials. -- Ref: https://developers.facebook.com/docs/facebook-login/manually-build-a-login-flow-getAppAccessToken-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+getAppAccessToken ::+     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)   => FacebookT Auth m AppAccessToken getAppAccessToken =-  runResourceInFb $-  do creds <- getCreds-     req <--       fbreq "/oauth/access_token" Nothing $-       tsq creds [("grant_type", "client_credentials")]-     response <- fbhttp req-     (token :: AE.Value) <- asJson response-     case AE.parseMaybe tokenParser token of-       Just appToken -> return $ AppAccessToken appToken-       _ ->-         E.throwIO $-         FbLibraryException ("Unable to parse: " <> (T.pack $ show token))+  runResourceInFb $ do+    creds <- getCreds+    req <-+      fbreq "/oauth/access_token" Nothing $+      tsq creds [("grant_type", "client_credentials")]+    response <- fbhttp req+    (token :: AE.Value) <- asJson response+    case AE.parseMaybe tokenParser token of+      Just appToken -> return $ AppAccessToken appToken+      _ ->+        E.throwIO $+        FbLibraryException ("Unable to parse: " <> (T.pack $ show token))   where     tokenParser :: AE.Value -> AE.Parser AccessTokenData     tokenParser val =@@ -88,29 +86,31 @@ -- Facebook URL you should redirect you user to.  Facebook will -- authenticate the user, authorize your app and then redirect -- the user back into the provider 'RedirectUrl'.-getUserAccessTokenStep1-  :: Monad m-  => RedirectUrl -> [Permission] -> FacebookT Auth m Text+getUserAccessTokenStep1 ::+     (Monad m, MonadIO m)+  => RedirectUrl+  -> [Permission]+  -> FacebookT Auth m Text getUserAccessTokenStep1 redirectUrl perms = do   creds <- getCreds-  withTier $-    \tier ->-       let urlBase =-             case tier of-               Production ->-                 "https://www.facebook.com/" <> apiVersion <>-                 "/dialog/oauth?client_id="-               Beta ->-                 "https://www.beta.facebook.com/" <> apiVersion <>-                 "/dialog/oauth?client_id="-       in T.concat $-          urlBase :-          appId creds :-          "&redirect_uri=" :-          redirectUrl :-          (case perms of-             [] -> []-             _ -> "&scope=" : L.intersperse "," (map unPermission perms))+  apiVersion <- getApiVersion+  withTier $ \tier ->+    let urlBase =+          case tier of+            Production ->+              "https://www.facebook.com/" <> apiVersion <>+              "/dialog/oauth?client_id="+            Beta ->+              "https://www.beta.facebook.com/" <> apiVersion <>+              "/dialog/oauth?client_id="+     in T.concat $+        urlBase :+        appId creds :+        "&redirect_uri=" :+        redirectUrl :+        (case perms of+           [] -> []+           _ -> "&scope=" : L.intersperse "," (map unPermission perms))  -- | The second step to get an user access token.  If the user is -- successfully authenticate and they authorize your application,@@ -119,8 +119,8 @@ -- request query parameters passed to your 'RedirectUrl' and give -- to this function that will complete the user authentication -- flow and give you an @'UserAccessToken'@.-getUserAccessTokenStep2-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+getUserAccessTokenStep2 ::+     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)   => RedirectUrl -- ^ Should be exactly the same      -- as in 'getUserAccessTokenStep1'.   -> [Argument] -- ^ Query parameters.@@ -130,23 +130,24 @@     [code@("code", _)] ->       runResourceInFb $       -- Get the access token data through Facebook's OAuth.-      do now <- liftIO getCurrentTime-         creds <- getCreds-         req <--           fbreq "/oauth/access_token" Nothing $-           tsq creds [code, ("redirect_uri", TE.encodeUtf8 redirectUrl)]-         response <- fbhttp req-         (userToken :: AE.Value) <- asJson response-         let (token, expire) = userAccessTokenParser now userToken+       do+        now <- liftIO getCurrentTime+        creds <- getCreds+        req <-+          fbreq "/oauth/access_token" Nothing $+          tsq creds [code, ("redirect_uri", TE.encodeUtf8 redirectUrl)]+        response <- fbhttp req+        (userToken :: AE.Value) <- asJson response+        let (token, expire) = userAccessTokenParser now userToken          -- Get user's ID throught Facebook's graph.-         userResponse <--           fbhttp =<<-           fbreq-             "/me"-             (Just (UserAccessToken "invalid id" token expire))-             [("fields", "id")]-         (userId :: UserId) <- asJson userResponse-         return $ UserAccessToken userId token expire+        userResponse <-+          fbhttp =<<+          fbreq+            "/me"+            (Just (UserAccessToken "invalid id" token expire))+            [("fields", "id")]+        (userId :: UserId) <- asJson userResponse+        return $ UserAccessToken userId token expire     _ ->       let [error_, errorReason, errorDescr] =             map@@ -154,13 +155,13 @@               ["error", "error_reason", "error_description"]           errorType = T.concat [t error_, " (", t errorReason, ")"]           t = TE.decodeUtf8With TE.lenientDecode-      in E.throwIO $ FacebookException errorType (t errorDescr)+       in E.throwIO $ FacebookException errorType (t errorDescr)  -- | Attoparsec parser for user access tokens returned by -- Facebook as a query string.  Returns an user access token with -- a broken 'UserId'.-userAccessTokenParser-  :: UTCTime -- ^ 'getCurrentTime'+userAccessTokenParser ::+     UTCTime -- ^ 'getCurrentTime'   -> AE.Value   -> (AccessTokenData, UTCTime) userAccessTokenParser now val =@@ -191,8 +192,8 @@ -- 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-  :: Monad m+getUserLogoutUrl ::+     Monad m   => UserAccessToken      -- ^ The user's access token.   -> RedirectUrl@@ -203,19 +204,18 @@ -- @https:\/\/www.beta.facebook.com\/@ when -- using the beta tier). getUserLogoutUrl (UserAccessToken _ data_ _) next = do-  withTier $-    \tier ->-       let urlBase =-             case tier of-               Production -> "https://www.facebook.com/logout.php?"-               Beta -> "https://www.beta.facebook.com/logout.php?"-       in TE.decodeUtf8 $-          urlBase <>-          HT.renderQuery-            False-            [ ("next", Just (TE.encodeUtf8 next))-            , ("access_token", Just (TE.encodeUtf8 data_))-            ]+  withTier $ \tier ->+    let urlBase =+          case tier of+            Production -> "https://www.facebook.com/logout.php?"+            Beta -> "https://www.beta.facebook.com/logout.php?"+     in TE.decodeUtf8 $+        urlBase <>+        HT.renderQuery+          False+          [ ("next", Just (TE.encodeUtf8 next))+          , ("access_token", Just (TE.encodeUtf8 data_))+          ]  -- | URL where the user is redirected to after Facebook -- authenticates the user authorizes your application.  This URL@@ -236,12 +236,14 @@ -- > -- > perms :: [Permission] -- > perms = ["user_about_me", "email", "offline_access"]-newtype Permission = Permission-  { unPermission :: Text+newtype Permission =+  Permission+    { unPermission :: Text     -- ^ Retrieves the 'Text' back from a 'Permission'.  Most of     -- the time you won't need to use this function, but you may     -- need it if you're a library author.-  } deriving (Eq, Ord)+    }+  deriving (Eq, Ord)  instance Show Permission where   show = show . unPermission@@ -250,9 +252,7 @@   fromString = Permission . fromString  -- | @True@ if the access token has expired, otherwise @False@.-hasExpired-  :: (Functor m, MonadIO m)-  => AccessToken anyKind -> m Bool+hasExpired :: (Functor m, MonadIO m) => AccessToken anyKind -> m Bool hasExpired token =   case accessTokenExpires token of     Nothing -> return False@@ -263,9 +263,10 @@ -- access token may not be valid as well.  For example, in the -- case of an user access token, they may have changed their -- password, logged out from Facebook or blocked your app.-isValid-  :: (R.MonadResource m, R.MonadUnliftIO m)-  => AccessToken anyKind -> FacebookT anyAuth m Bool+isValid ::+     (R.MonadResource m, R.MonadUnliftIO m)+  => AccessToken anyKind+  -> FacebookT anyAuth m Bool isValid token = do   expired <- hasExpired token   if expired@@ -283,7 +284,7 @@              -- will actually work with user access tokens,              -- too, but they have another, better way of              -- being checked.-         in httpCheck =<< fbreq page (Just token) []+          in httpCheck =<< fbreq page (Just token) []  -- | Extend the expiration time of an user access token (see -- <https://developers.facebook.com/docs/offline-access-deprecation/>,@@ -296,8 +297,8 @@ -- have the same data and expiration time as before, but you -- can't assume this).  Note that expired access tokens can't be -- extended, only valid tokens.-extendUserAccessToken-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+extendUserAccessToken ::+     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)   => UserAccessToken   -> FacebookT Auth m (Either FacebookException UserAccessToken) extendUserAccessToken token@(UserAccessToken uid data_ _) = do@@ -307,23 +308,23 @@     else tryToExtend   where     tryToExtend =-      runResourceInFb $-      do creds <- getCreds-         req <--           fbreq "/oauth/access_token" Nothing $-           tsq-             creds-             [ ("grant_type", "fb_exchange_token")-             , ("fb_exchange_token", TE.encodeUtf8 data_)-             ]-         response <- fbhttp req-         userToken <- E.try $ asJson response-         case userToken of-           Right val -> do-             now <- liftIO getCurrentTime-             let (extendedtoken, expire) = userAccessTokenParser now val-             return $ Right $ UserAccessToken uid extendedtoken expire-           Left exc -> return (Left exc)+      runResourceInFb $ do+        creds <- getCreds+        req <-+          fbreq "/oauth/access_token" Nothing $+          tsq+            creds+            [ ("grant_type", "fb_exchange_token")+            , ("fb_exchange_token", TE.encodeUtf8 data_)+            ]+        response <- fbhttp req+        userToken <- E.try $ asJson response+        case userToken of+          Right val -> do+            now <- liftIO getCurrentTime+            let (extendedtoken, expire) = userAccessTokenParser now val+            return $ Right $ UserAccessToken uid extendedtoken expire+          Left exc -> return (Left exc)     hasExpiredExc =       mkExc         [ "the user access token has already expired, "@@ -335,38 +336,41 @@ -- (<https://developers.facebook.com/docs/authentication/signed_request/>), -- verifies its authencity and integrity using the HMAC and -- decodes its JSON object.-parseSignedRequest-  :: (AE.FromJSON a, Monad m)+parseSignedRequest ::+     (AE.FromJSON a, Monad m, MonadIO m)   => B8.ByteString -- ^ Encoded Facebook signed request   -> FacebookT Auth m (Maybe a) parseSignedRequest signedRequest =   runMaybeT $   -- Split, decode and JSON-parse-  do let (encodedSignature, encodedUnparsedPayloadWithDot) = B8.break (== '.') signedRequest-     ('.', encodedUnparsedPayload) <--       MaybeT $ return (B8.uncons encodedUnparsedPayloadWithDot)-     signature <- eitherToMaybeT $ Base64URL.decode $ addBase64Padding encodedSignature-     unparsedPayload <- eitherToMaybeT $ Base64URL.decode $ addBase64Padding encodedUnparsedPayload-     payload <- eitherToMaybeT $ AB.parseOnly json' unparsedPayload+   do+    let (encodedSignature, encodedUnparsedPayloadWithDot) =+          B8.break (== '.') signedRequest+    ('.', encodedUnparsedPayload) <-+      MaybeT $ return (B8.uncons encodedUnparsedPayloadWithDot)+    signature <-+      eitherToMaybeT $+      convertFromBase Base64 $ addBase64Padding encodedSignature+    unparsedPayload <-+      eitherToMaybeT $+      convertFromBase Base64 $ addBase64Padding encodedUnparsedPayload+    payload <- eitherToMaybeT $ AB.parseOnly json' unparsedPayload      -- Verify signature-     SignedRequestAlgorithm algo <- fromJson payload-     guard (algo == "HMAC-SHA256")-     hmacKey <- credsToHmacKey `liftM` lift getCreds-     let expectedSignature = Cereal.encode $ hmac' hmacKey encodedUnparsedPayload-     guard (signature `constTimeEq` expectedSignature)+    SignedRequestAlgorithm algo <- fromJson payload+    guard (algo == "HMAC-SHA256")+    creds <- lift getCreds+    let hmacKey = credsToHmacKey creds+        expectedSignature = hmac hmacKey encodedUnparsedPayload :: HMAC SHA256+    guard ((signature :: ScrubbedBytes) == (convert expectedSignature))      -- Parse user data type-     fromJson payload+    fromJson payload   where-    eitherToMaybeT-      :: Monad m-      => Either a b -> MaybeT m b+    eitherToMaybeT :: Monad m => Either a b -> MaybeT m b     eitherToMaybeT = MaybeT . return . either (const Nothing) Just-    fromJson-      :: (AE.FromJSON a, Monad m)-      => AE.Value -> MaybeT m a+    fromJson :: (AE.FromJSON a, Monad m) => AE.Value -> MaybeT m a     fromJson = eitherToMaybeT . AE.parseEither AE.parseJSON-    credsToHmacKey :: Credentials -> MacKey ctx SHA256-    credsToHmacKey = MacKey . appSecretBS+    -- credsToHmacKey :: Credentials -> MacKey ctx SHA256+    credsToHmacKey = appSecretBS  newtype SignedRequestAlgorithm =   SignedRequestAlgorithm Text@@ -393,8 +397,8 @@     drem = B.length bs `mod` 4  -- | Get detailed information about an access token.-debugToken-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+debugToken ::+     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => AppAccessToken -- ^ Your app access token.   -> AccessTokenData -- ^ The access token you want to debug.   -> FacebookT Auth m DebugToken@@ -406,32 +410,31 @@   let muserToken =         UserAccessToken <$> dtUserId ret <*> return userTokenData <*>         dtExpiresAt ret-  return-    ret-    { dtAccessToken = muserToken-    }+  return ret {dtAccessToken = muserToken}  -- | Helper used in 'debugToken'.  Unfortunately, we can't use 'Pager' here.-data Undata a = Undata-  { undata :: a-  }+data Undata a =+  Undata+    { undata :: a+    } -instance AE.FromJSON a =>-         AE.FromJSON (Undata a) where+instance AE.FromJSON a => AE.FromJSON (Undata a) where   parseJSON (AE.Object v) = Undata <$> v AE..: "data"   parseJSON _ = mzero  -- | Detailed information about an access token (cf. 'debugToken').-data DebugToken = DebugToken-  { dtAppId :: Maybe Text-  , dtAppName :: Maybe Text-  , dtExpiresAt :: Maybe UTCTime-  , dtIsValid :: Maybe Bool-  , dtIssuedAt :: Maybe UTCTime-  , dtScopes :: Maybe [Permission]-  , dtUserId :: Maybe Id-  , dtAccessToken :: Maybe UserAccessToken-  } deriving (Eq, Ord, Show, Typeable)+data DebugToken =+  DebugToken+    { dtAppId :: Maybe Text+    , dtAppName :: Maybe Text+    , dtExpiresAt :: Maybe UTCTime+    , dtIsValid :: Maybe Bool+    , dtIssuedAt :: Maybe UTCTime+    , dtScopes :: Maybe [Permission]+    , dtUserId :: Maybe Id+    , dtAccessToken :: Maybe UserAccessToken+    }+  deriving (Eq, Ord, Show, Typeable)  -- | Note: this instance always sets 'dtAccessToken' to -- 'Nothing', but 'debugToken' will update this field before

@@ -2,6 +2,7 @@ {-#LANGUAGE FlexibleContexts#-} {-#LANGUAGE OverloadedStrings#-} {-#LANGUAGE CPP#-}+ module Facebook.Base     ( fbreq     , ToSimpleQuery(..)@@ -12,15 +13,12 @@     , fbhttp     , fbhttpHelper     , httpCheck-    , apiVersion     ) where  import Control.Applicative-import Control.Monad (mzero) import Control.Monad.IO.Class (MonadIO) import Data.ByteString.Char8 (ByteString) import Data.Text (Text)-import Data.Typeable (Typeable)  import qualified UnliftIO.Exception as E import Control.Monad.Trans.Class (MonadTrans)@@ -47,17 +45,23 @@ import Facebook.Types import Facebook.Monad -apiVersion :: Text-apiVersion = "v2.8"- -- | A plain 'H.Request' to a Facebook API.  Use this instead of -- 'def' when creating new 'H.Request'@s@ for Facebook.-fbreq :: Monad m =>-         Text                        -- ^ Path. Should start from "/".+fbreq :: MonadIO m+      => Text                        -- ^ Path. Should start from "/".       -> Maybe (AccessToken anyKind) -- ^ Access token.       -> HT.SimpleQuery              -- ^ Parameters.       -> FacebookT anyAuth m H.Request-fbreq path mtoken query =+fbreq path mtoken query = do++    apiVersion <- getApiVersion+    creds      <- getMCreds++    let appSecretProofAdder = case creds of+          Just c@( Credentials _ _ _ True ) -> addAppSecretProof c+          _ -> const id ++     withTier $ \tier ->       let host = case tier of                    Production -> "graph.facebook.com"@@ -68,8 +72,8 @@              , H.path          = TE.encodeUtf8 ("/" <> apiVersion <> path)              , H.redirectCount = 3              , H.queryString   =-                 HT.renderSimpleQuery False $-                 maybe id tsq mtoken query+                 HT.renderSimpleQuery False+                 $ appSecretProofAdder mtoken $ maybe id tsq mtoken query #if MIN_VERSION_http_client(0,5,0)              , H.responseTimeout = H.responseTimeoutMicro 120000000 -- 2 minutes #else@@ -126,26 +130,6 @@         H.Response (C.ConduitT () ByteString m ())      -> FacebookT anyAuth m ByteString asBS response = lift $ C.runConduit $ H.responseBody response .| fmap B.concat CL.consume----- | An exception that may be thrown by functions on this--- package.  Includes any information provided by Facebook.-data FacebookException =-    -- | An exception coming from Facebook.-    FacebookException { fbeType    :: Text-                      , fbeMessage :: Text-                      }-    -- | An exception coming from the @fb@ package's code.-  | FbLibraryException { fbeMessage :: Text }-    deriving (Eq, Ord, Show, Read, Typeable)--instance A.FromJSON FacebookException where-    parseJSON (A.Object v) =-        FacebookException <$> v A..: "type"-                          <*> v A..: "message"-    parseJSON _ = mzero--instance E.Exception FacebookException where   -- | Same as 'H.http', but tries to parse errors and throw

@@ -8,6 +8,7 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}  module Facebook.Monad   ( FacebookT@@ -18,69 +19,86 @@   , runNoAuthFacebookT   , beta_runFacebookT   , beta_runNoAuthFacebookT+  , getApiVersion   , getCreds+  , getMCreds   , getManager   , getTier   , withTier+  , addAppSecretProof+  , makeAppSecretProof   , runResourceInFb   , mapFacebookT+  , setApiVersion    -- * Re-export   , lift   ) where -import Control.Applicative (Applicative, Alternative)+import Control.Applicative (Alternative, Applicative) import Control.Monad (MonadPlus, liftM) import Control.Monad.Base (MonadBase(..))+import Control.Monad.Fail (MonadFail(..)) import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger (MonadLogger(..)) import Control.Monad.Trans.Class (MonadTrans(lift))-import UnliftIO import Control.Monad.Trans.Reader (ReaderT(..), ask, mapReaderT)-import Data.Typeable (Typeable) import qualified Control.Monad.Trans.Resource as R--import qualified Network.HTTP.Conduit as H-+import Crypto.Hash.Algorithms (SHA256)+import Crypto.MAC.HMAC (HMAC(..), hmac)+import Data.ByteArray.Encoding (Base(..), convertToBase)+import qualified Data.Text.Encoding as TE+import Data.Typeable (Typeable) import Facebook.Types+import qualified Network.HTTP.Conduit as H+import qualified Network.HTTP.Types as HT+import UnliftIO+import qualified UnliftIO.Exception as E  -- | @FacebookT auth m a@ is this library's monad transformer. -- Contains information needed to issue commands and queries to -- Facebook.  The phantom type @auth@ may be either 'Auth' (you -- have supplied your 'Credentials') or 'NoAuth' (you have not -- supplied any 'Credentials').-newtype FacebookT auth m a = F-  { unF :: ReaderT FbData m a -- FbData -> m a-  } deriving (Functor, Applicative, Alternative, Monad, MonadFix, MonadPlus, MonadIO, MonadTrans, R.MonadThrow)+newtype FacebookT auth m a =+  F+    { unF :: ReaderT FbData m a -- FbData -> m a+    }+  deriving ( Functor+           , Applicative+           , Alternative+           , Monad+           , MonadFix+           , MonadPlus+           , MonadIO+           , MonadTrans+           , R.MonadThrow+           , MonadFail+           )  deriving instance          (R.MonadResource m, MonadBase IO m) =>          R.MonadResource (FacebookT auth m) -instance MonadBase b m =>-         MonadBase b (FacebookT auth m) where+instance MonadBase b m => MonadBase b (FacebookT auth m) where   liftBase = lift . liftBase  -- askUnliftIO = ReaderT $ \r -> --                 withUnliftIO $ \u -> -- return (UnliftIO (unliftIO u . flip runReaderT r))-instance (MonadIO m, MonadUnliftIO m) =>-         MonadUnliftIO (FacebookT auth m) where+instance (MonadIO m, MonadUnliftIO m) => MonadUnliftIO (FacebookT auth m) where   askUnliftIO :: FacebookT auth m (UnliftIO (FacebookT auth m))   askUnliftIO =     F-      (ReaderT $-       \(r :: FbData) ->-          withUnliftIO $-          \(u :: UnliftIO m) ->-             return-               (UnliftIO-                  (\(x :: FacebookT auth m a) ->-                      (unliftIO u ((flip runReaderT r) (unF x))))))+      (ReaderT $ \(r :: FbData) ->+         withUnliftIO $ \(u :: UnliftIO m) ->+           return+             (UnliftIO+                (\(x :: FacebookT auth m a) ->+                   (unliftIO u ((flip runReaderT r) (unF x))))))  -- | Since @fb-0.14.8@.-instance MonadLogger m =>-         MonadLogger (FacebookT auth m) where+instance MonadLogger m => MonadLogger (FacebookT auth m) where   monadLoggerLog loc src lvl msg = lift (monadLoggerLog loc src lvl msg)  -- | Phantom type stating that you have provided your@@ -95,11 +113,14 @@   deriving (Typeable)  -- | Internal data kept inside 'FacebookT'.-data FbData = FbData-  { fbdCreds :: Credentials -- ^ Can be 'undefined'!-  , fbdManager :: !H.Manager-  , fbdTier :: !FbTier-  } deriving (Typeable)+data FbData =+  FbData+    { fbdCreds :: Maybe Credentials+    , fbdManager :: !H.Manager+    , fbdTier :: !FbTier+    , fbdApiVersion :: IORef ApiVersion+    }+  deriving (Typeable)  -- | Which Facebook tier should be used (see -- <https://developers.facebook.com/support/beta-tier/>).@@ -108,64 +129,114 @@   | Beta   deriving (Eq, Ord, Show, Read, Enum, Typeable) +defaultApiVersion :: ApiVersion+defaultApiVersion = "v3.2"++-- | Set the Graph API version.+setApiVersion :: (MonadIO m) => ApiVersion -> FacebookT anyAuth m ()+setApiVersion apiVersion = do+  ref <- fbdApiVersion `liftM` F ask+  atomicModifyIORef' ref (\_ -> (apiVersion, ()))+  return ()+ -- | Run a computation in the 'FacebookT' monad transformer with -- your credentials.-runFacebookT-  :: Credentials -- ^ Your app's credentials.+runFacebookT ::+     (MonadIO m)+  => Credentials -- ^ Your app's credentials.   -> H.Manager -- ^ Connection manager (see 'H.withManager').   -> FacebookT Auth m a   -> m a-runFacebookT creds manager (F act) =-  runReaderT act (FbData creds manager Production)+runFacebookT creds manager (F act) = do+  apiref <- newIORef defaultApiVersion+  runReaderT act (FbData (Just creds) manager Production apiref) +addAppSecretProof ::+     Credentials+  -> Maybe (AccessToken anykind)+  -> HT.SimpleQuery+  -> HT.SimpleQuery+addAppSecretProof (Credentials _ _ _ False) _ query = query+addAppSecretProof creds mtoken query = makeAppSecretProof creds mtoken <> query++-- | Make an appsecret_proof in case the given credentials access token is a+-- user access token.+-- See: https://developers.facebook.com/docs/graph-api/securing-requests/#appsecret_proof+makeAppSecretProof ::+     Credentials -- ^ App credentials+  -> Maybe (AccessToken anyKind) -- ^+  -> HT.SimpleQuery+makeAppSecretProof creds (Just (UserAccessToken _ accessToken _)) =+  [(TE.encodeUtf8 "appsecret_proof", proof)]+  where+    hmacData :: HMAC SHA256+    hmacData = hmac (appSecretBS creds) (TE.encodeUtf8 accessToken)+    proof = convertToBase Base16 hmacData+makeAppSecretProof _ _ = []+ -- | Run a computation in the 'FacebookT' monad without -- credentials.-runNoAuthFacebookT :: H.Manager -> FacebookT NoAuth m a -> m a-runNoAuthFacebookT manager (F act) =-  let creds = error "runNoAuthFacebookT: never here, serious bug"-  in runReaderT act (FbData creds manager Production)+runNoAuthFacebookT ::+     (MonadIO m)+  => H.Manager -- ^ Connection manager (see 'H.withManager').+  -> FacebookT NoAuth m a+  -> m a+runNoAuthFacebookT manager (F act) = do+  apiref <- newIORef defaultApiVersion+  runReaderT act (FbData Nothing manager Production apiref)  -- | Same as 'runFacebookT', but uses Facebook's beta tier (see -- <https://developers.facebook.com/support/beta-tier/>).-beta_runFacebookT :: Credentials -> H.Manager -> FacebookT Auth m a -> m a-beta_runFacebookT creds manager (F act) =-  runReaderT act (FbData creds manager Beta)+beta_runFacebookT ::+     (MonadIO m) => Credentials -> H.Manager -> FacebookT Auth m a -> m a+beta_runFacebookT creds manager (F act) = do+  apiref <- newIORef defaultApiVersion+  runReaderT act (FbData (Just creds) manager Beta apiref)  -- | Same as 'runNoAuthFacebookT', but uses Facebook's beta tier -- (see <https://developers.facebook.com/support/beta-tier/>).-beta_runNoAuthFacebookT :: H.Manager -> FacebookT NoAuth m a -> m a-beta_runNoAuthFacebookT manager (F act) =-  let creds = error "beta_runNoAuthFacebookT: never here, serious bug"-  in runReaderT act (FbData creds manager Beta)+beta_runNoAuthFacebookT ::+     (MonadIO m) => H.Manager -> FacebookT NoAuth m a -> m a+beta_runNoAuthFacebookT manager (F act) = do+  apiref <- newIORef defaultApiVersion+  runReaderT act (FbData Nothing manager Beta apiref) +-- | Get the user's credentials, fail if they are not available.+getCreds :: (Monad m, MonadIO m) => FacebookT Auth m Credentials+getCreds = do+  mCreds <- getMCreds+  case mCreds of+    Nothing -> E.throwIO $ FbLibraryException "Couldn't get credentials."+    Just creds -> return creds+ -- | Get the user's credentials.-getCreds-  :: Monad m-  => FacebookT Auth m Credentials-getCreds = fbdCreds `liftM` F ask+getMCreds :: Monad m => FacebookT anyAuth m (Maybe Credentials)+getMCreds = fbdCreds `liftM` F ask +-- | Get the Graph API version.+getApiVersion :: MonadIO m => FacebookT anyAuth m ApiVersion+getApiVersion = do+  ref <- fbdApiVersion `liftM` F ask+  apiVersion <- readIORef ref+  pure apiVersion+ -- | Get the 'H.Manager'.-getManager-  :: Monad m-  => FacebookT anyAuth m H.Manager+getManager :: Monad m => FacebookT anyAuth m H.Manager getManager = fbdManager `liftM` F ask  -- | Get the 'FbTier'.-getTier-  :: Monad m-  => FacebookT anyAuth m FbTier+getTier :: Monad m => FacebookT anyAuth m FbTier getTier = fbdTier `liftM` F ask  -- | Run a pure function that depends on the 'FbTier' being used.-withTier-  :: Monad m-  => (FbTier -> a) -> FacebookT anyAuth m a+withTier :: Monad m => (FbTier -> a) -> FacebookT anyAuth m a withTier = flip liftM getTier  -- | Run a 'ResourceT' inside a 'FacebookT'.-runResourceInFb-  :: (R.MonadResource m, MonadUnliftIO m)-  => FacebookT anyAuth (R.ResourceT m) a -> FacebookT anyAuth m a+runResourceInFb ::+     (R.MonadResource m, MonadUnliftIO m)+  => FacebookT anyAuth (R.ResourceT m) a+  -> FacebookT anyAuth m a runResourceInFb (F inner) = F $ ask >>= lift . R.runResourceT . runReaderT inner  -- | Transform the computation inside a 'FacebookT'.

@@ -8,6 +8,7 @@   ) where  import Control.Arrow (first)+import Control.Monad.IO.Class import Data.Function (on) import Data.String (IsString(..)) import Data.Text (Text)@@ -27,7 +28,7 @@ -- >              , "when"   #= now ] -- >              token createAction-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)   => Action -- ^ Action kind to be created.   -> [Argument] -- ^ Arguments of the action.   -> Maybe AppAccessToken

@@ -72,7 +72,7 @@   -> [Argument] -- ^ Arguments to be passed to Facebook   -> Maybe AppAccessToken -- ^ Optional user access token   -> FacebookT anyAuth m Page-getPage_ id_ = getObject $ ("/" <> idCode id_)+getPage_ id_ = getObject $ "/" <> idCode id_  -- | Search pages by keyword. The user access token is optional. searchPages

@@ -17,30 +17,31 @@  import Control.Applicative ((<$>), (<*>)) import Control.Monad (liftM, mzero, void)-import Crypto.Hash.CryptoAPI (SHA1)-import Data.ByteString.Char8 (ByteString)-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8)-import Data.Typeable (Typeable)-+import Control.Monad.IO.Class import qualified Control.Monad.Trans.Resource as R-import qualified Crypto.Classes as Crypto-import qualified Crypto.HMAC as Crypto+import Crypto.Hash.Algorithms (SHA1)+import Crypto.MAC.HMAC (HMAC(..), hmac) import qualified Data.Aeson as A-import qualified Data.ByteString.Base16 as Base16+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.Types-import Facebook.Monad 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@@ -89,8 +90,8 @@ -- 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)+modifySubscription ::+     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => RealTimeUpdateObject      -- ^ Type of objects whose subscription you      -- and to add or modify.@@ -112,31 +113,27 @@         , "callback_url" #= callbackUrl         , "verify_token" #= verifyToken         ]-  runResourceInFb $-    do req <- fbreq path (Just apptoken) args-       void $-         fbhttp-           req-           { H.method = HT.methodPost-           }+  runResourceInFb $ do+    req <- fbreq path (Just apptoken) args+    void $ fbhttp req {H.method = HT.methodPost}   return ()  -- | (Internal)  Get the subscription's path.-getSubscriptionsPath-  :: Monad m-  => FacebookT Auth m Text+getSubscriptionsPath :: (Monad m, MonadIO m) => FacebookT Auth m Text getSubscriptionsPath = do   creds <- getCreds   return $ T.concat ["/", appId creds, "/subscriptions"]  -- | Information returned by Facebook about a real-time update -- notification subscription.-data RealTimeUpdateSubscription = RealTimeUpdateSubscription-  { rtusObject :: RealTimeUpdateObject-  , rtusCallbackUrl :: RealTimeUpdateUrl-  , rtusFields :: [RealTimeUpdateField]-  , rtusActive :: Bool-  } deriving (Eq, Ord, Show, Typeable)+data RealTimeUpdateSubscription =+  RealTimeUpdateSubscription+    { rtusObject :: RealTimeUpdateObject+    , rtusCallbackUrl :: RealTimeUpdateUrl+    , rtusFields :: [RealTimeUpdateField]+    , rtusActive :: Bool+    }+  deriving (Eq, Ord, Show, Typeable)  instance A.FromJSON RealTimeUpdateSubscription where   parseJSON (A.Object v) =@@ -146,24 +143,25 @@   parseJSON _ = mzero  -- | List current real-time update subscriptions.-listSubscriptions-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)-  => AppAccessToken -> FacebookT Auth m [RealTimeUpdateSubscription]+listSubscriptions ::+     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+  => AppAccessToken+  -> FacebookT Auth m [RealTimeUpdateSubscription] listSubscriptions apptoken = do   path <- getSubscriptionsPath   pager <- getObject path [] (Just apptoken)   src <- fetchAllNextPages pager   lift $ C.runConduit $ src C..| CL.consume --- | Verifies the input's authenticity (i.e. it comes from+-- | 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+verifyRealTimeUpdateNotifications ::+     (Monad m, MonadIO m)   => ByteString      -- ^ @X-Hub-Signature@ HTTP header's value.   -> L.ByteString@@ -171,12 +169,13 @@   -> FacebookT Auth m (Maybe L.ByteString) verifyRealTimeUpdateNotifications sig body = do   creds <- getCreds-  let key :: Crypto.MacKey ctx SHA1-      key = Crypto.MacKey (appSecretBS creds)-      hash = Crypto.hmac key body-      expected = "sha1=" <> Base16.encode (Crypto.encode hash)+  let hmacData :: HMAC SHA1+      hmacData = hmac (appSecretBS creds) (L.toStrict body)+      hash :: B.ByteString+      hash = convertToBase Base16 hmacData+      expected = "sha1=" <> hash   return $!-    if sig `Crypto.constTimeEq` expected+    if ((convert sig :: ScrubbedBytes) == (convert expected))       then Just body       else Nothing @@ -185,14 +184,15 @@ -- 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)+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 = (liftM (>>= A.decode) .) . verifyRealTimeUpdateNotifications+getRealTimeUpdateNotifications =+  (liftM (>>= A.decode) .) . verifyRealTimeUpdateNotifications  -- | When data changes and there's a valid subscription, Facebook -- will @POST@ to your 'RealTimeUpdateUrl' with a JSON-encoded@@ -207,23 +207,26 @@ -- the value of 'rtunObject'. -- -- We recommend using 'getRealTimeUpdateNotifications'.-data RealTimeUpdateNotification a = RealTimeUpdateNotification-  { rtunObject :: RealTimeUpdateObject-  , rtunEntries :: [a]-  } deriving (Eq, Ord, Show, Typeable)+data RealTimeUpdateNotification a =+  RealTimeUpdateNotification+    { rtunObject :: RealTimeUpdateObject+    , rtunEntries :: [a]+    }+  deriving (Eq, Ord, Show, Typeable) -instance A.FromJSON a =>-         A.FromJSON (RealTimeUpdateNotification a) where+instance A.FromJSON a => A.FromJSON (RealTimeUpdateNotification a) where   parseJSON (A.Object v) =     RealTimeUpdateNotification <$> v A..: "object" <*> v A..: "entry"   parseJSON _ = mzero  -- | A notification for the 'UserRTUO' object.-data RealTimeUpdateNotificationUserEntry = RealTimeUpdateNotificationUserEntry-  { rtuneUserId :: Id-  , rtuneChangedFields :: [RealTimeUpdateField]-  , rtuneTime :: Integer-  } deriving (Eq, Ord, Show, Typeable)+data RealTimeUpdateNotificationUserEntry =+  RealTimeUpdateNotificationUserEntry+    { rtuneUserId :: Id+    , rtuneChangedFields :: [RealTimeUpdateField]+    , rtuneTime :: Integer+    }+  deriving (Eq, Ord, Show, Typeable)  instance A.FromJSON RealTimeUpdateNotificationUserEntry where   parseJSON (A.Object v) =

@@ -16,6 +16,7 @@  import Control.Applicative ((<$>), (<*>)) import Control.Monad (unless, mzero)+import Control.Monad.IO.Class import Data.ByteString.Lazy (fromStrict) import Data.Default import Data.Text@@ -94,7 +95,7 @@ -- | Create a new test user. -- Ref: https://developers.facebook.com/docs/graph-api/reference/v2.8/app/accounts/test-users#publish createTestUser-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)   => CreateTestUser -- ^ How the test user should be      -- created.   -> AppAccessToken -- ^ Access token for your app.@@ -106,7 +107,7 @@  -- | Get a list of test users. getTestUsers-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)   => AppAccessToken -- ^ Access token for your app.   -> FacebookT Auth m (Pager TestUser) getTestUsers token = do@@ -114,7 +115,7 @@   getObject ("/" <> appId creds <> "/accounts/test-users") [] (Just token)  disassociateTestuser-  :: (R.MonadUnliftIO m, R.MonadThrow m, R.MonadResource m)+  :: (R.MonadUnliftIO m, R.MonadThrow m, R.MonadResource m, MonadIO m)   => TestUser -> AppAccessToken -> FacebookT Auth m Bool disassociateTestuser testUser _token = do   creds <- getCreds

@@ -7,6 +7,7 @@  module Facebook.Types   ( Credentials(..)+  , ApiVersion   , appIdBS   , appSecretBS   , AccessToken(..)@@ -23,10 +24,12 @@   , Argument   , (<>)   , FbUTCTime(..)+  , FacebookException(..)   ) where  import Control.Applicative ((<$>), (<*>), pure) import Control.Monad (mzero)+import qualified UnliftIO.Exception as E import Data.ByteString (ByteString) import Data.Int (Int64) #if !(MIN_VERSION_base(4,11,0))@@ -57,6 +60,7 @@   { appName :: Text -- ^ Your application name (e.g. for Open Graph calls).   , appId :: Text -- ^ Your application ID.   , appSecret :: Text -- ^ Your application secret key.+  , appSecretProof :: Bool -- ^ To enable app secret proof verification   } deriving (Eq, Ord, Show, Read, Typeable)  -- | 'appId' for 'ByteString'.@@ -67,6 +71,11 @@ appSecretBS :: Credentials -> ByteString appSecretBS = TE.encodeUtf8 . appSecret ++-- | Graph API version.+-- See: https://developers.facebook.com/docs/graph-api/changelog+type ApiVersion = Text+ -- | 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.@@ -234,3 +243,23 @@   parseJSON _ =     fail       "could not parse FbUTCTime from something which is not a string or number"++-- | An exception that may be thrown by functions on this+-- package.  Includes any information provided by Facebook.+data FacebookException =+    -- | An exception coming from Facebook.+    FacebookException { fbeType    :: Text+                      , fbeMessage :: Text+                      }+    -- | An exception coming from the @fb@ package's code.+  | FbLibraryException { fbeMessage :: Text }+    deriving (Eq, Ord, Show, Read, Typeable)++instance A.FromJSON FacebookException where+    parseJSON (A.Object v) =+        FacebookException <$> v A..: "type"+                          <*> v A..: "message"+    parseJSON _ = mzero++instance E.Exception FacebookException where+

@@ -6,22 +6,9 @@   , getCredentials   ) where -import Control.Applicative import Control.Monad (mzero) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (lift)-import Data.Function (on)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Maybe (isJust, isNothing)-import Data.Text (Text)-import Data.Time (parseTime)-import Data.Word (Word, Word8, Word16, Word32, Word64)-import System.Environment (getEnv)-import System.Exit (exitFailure)-import System.IO.Error (isDoesNotExistError)-import Data.List ((\\))-import Data.Monoid ((<>))-import qualified UnliftIO.Exception as E import qualified Control.Monad.Trans.Resource as R import qualified Data.Aeson as A import qualified Data.Aeson.Types as A@@ -29,15 +16,24 @@ import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Default as D+import Data.Int (Int16, Int32, Int64, Int8)+import Data.List ((\\)) import qualified Data.Map as Map+import Data.Maybe (isJust, isNothing) import qualified Data.Maybe as M-import qualified Data.Set as S+import Data.Monoid ((<>))+import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Time as TI+import Data.Word (Word, Word16, Word32, Word64, Word8) import qualified Facebook as FB import qualified Network.HTTP.Conduit as H+import System.Environment (getEnv)+import System.Exit (exitFailure)+import System.IO.Error (isDoesNotExistError) import qualified Test.QuickCheck as QC+import qualified UnliftIO.Exception as E  import Test.HUnit ((@?=)) import Test.Hspec@@ -50,7 +46,8 @@     tryToGet = do       [appName, appId, appSecret] <-         mapM getEnv ["APP_NAME", "APP_ID", "APP_SECRET"]-      return $ FB.Credentials (T.pack appName) (T.pack appId) (T.pack appSecret)+      return $+        FB.Credentials (T.pack appName) (T.pack appId) (T.pack appSecret) True     showHelp exc       | not (isDoesNotExistError exc) = E.throwIO exc     showHelp _ = do@@ -78,12 +75,13 @@       exitFailure  invalidCredentials :: FB.Credentials-invalidCredentials = FB.Credentials "this" "isn't" "valid"+invalidCredentials = FB.Credentials "this" "isn't" "valid" False  invalidUserAccessToken :: FB.UserAccessToken-invalidUserAccessToken = FB.UserAccessToken (FB.Id "invalid") "user" farInTheFuture+invalidUserAccessToken =+  FB.UserAccessToken (FB.Id "invalid") "user" farInTheFuture   where-    Just farInTheFuture = parseTime (error "farInTheFuture") "%Y" "3000"+    Just farInTheFuture = TI.parseTimeM True TI.defaultTimeLocale "%Y" "3000"  -- It's actually important to use 'farInTheFuture' since we -- don't want any tests rejecting this invalid user access@@ -94,28 +92,29 @@ main :: IO () main = do   manager <- H.newManager H.tlsManagerSettings-  liftIO $-    do creds <- getCredentials-       hspec $+  liftIO $ do+    creds <- getCredentials+    hspec $        -- Run the tests twice, once in Facebook's production tier...-         do facebookTests-              "Production tier: "-              creds-              manager-              (R.runResourceT . FB.runFacebookT creds manager)-              (R.runResourceT . FB.runNoAuthFacebookT manager)+     do+      facebookTests+        "Production tier: "+        creds+        manager+        (R.runResourceT . (FB.runFacebookT creds manager))+        (R.runResourceT . (FB.runNoAuthFacebookT manager))             -- ...and the other in Facebook's beta tier.-            facebookTests-              "Beta tier: "-              creds-              manager-              (R.runResourceT . FB.beta_runFacebookT creds manager)-              (R.runResourceT . FB.beta_runNoAuthFacebookT manager)+      facebookTests+        "Beta tier: "+        creds+        manager+        (R.runResourceT . (FB.beta_runFacebookT creds manager))+        (R.runResourceT . (FB.beta_runNoAuthFacebookT manager))             -- Tests that don't depend on which tier is chosen.-            libraryTests manager+      libraryTests manager -facebookTests-  :: String+facebookTests ::+     String   -> FB.Credentials   -> H.Manager   -> (forall a. FB.FacebookT FB.Auth (R.ResourceT IO) a -> IO a)@@ -123,247 +122,233 @@   -> Spec facebookTests pretitle creds manager runAuth runNoAuth = do   let describe' = describe . (pretitle ++)-  describe' "getAppAccessToken" $-    do it "works and returns a valid app access token" $-         runAuth $-         do token <- FB.getAppAccessToken-            FB.isValid token #?= True-       it "throws a FacebookException on invalid credentials" $-         R.runResourceT $-         FB.runFacebookT invalidCredentials manager $-         do ret <- E.try $ FB.getAppAccessToken-            case ret of-              Right token -> fail $ show token-              Left (_ :: FB.FacebookException) ->-                lift $ lift (return () :: IO ())-  describe' "isValid" $-    do it "returns False on a clearly invalid user access token" $-         runNoAuth $ FB.isValid invalidUserAccessToken #?= False-       it "returns False on a clearly invalid app access token" $-         runNoAuth $ FB.isValid invalidAppAccessToken #?= False-  describe' "debugToken" $-    do it "works on a test user access token" $-         do runAuth $-              withTestUser D.def $-              \testUser -> do-                Just testUserAccessTokenData <--                  return (FB.tuAccessToken testUser)-                appToken <- FB.getAppAccessToken-                ret <- FB.debugToken appToken testUserAccessTokenData-                now <- liftIO TI.getCurrentTime-                FB.dtAppId ret &?= Just (FB.appId creds)-                FB.dtAppName ret &?= Just (FB.appName creds)-                case FB.dtExpiresAt ret of-                  Nothing -> fail "dtExpiresAt is Nothing"-                  Just t -> compare t now &?= GT-                FB.dtIsValid ret &?= Just True-                case FB.dtIssuedAt ret of-                  Nothing -> return () -- ok since it's a test user-                  Just t -> compare t now &?= LT-                isJust (FB.dtScopes ret) &?= True-                FB.dtUserId ret &?= Just (FB.tuId testUser)-                case FB.dtAccessToken ret of-                  Nothing -> fail "dtAccessToken is Nothing"-                  Just t -> do-                    let f-                          :: FB.UserAccessToken-                          -> FB.FacebookT FB.Auth (R.ResourceT IO) ()-                        f (FB.UserAccessToken uid dt exps) = do-                          uid &?= FB.tuId testUser-                          dt &?= testUserAccessTokenData-                          Just exps &?= FB.dtExpiresAt ret-                    f t-  describe' "getObject" $-    do it "is able to fetch Facebook's own page" $-         do val <--              runAuth $ -- Needs permission now: https://developers.facebook.com/docs/graph-api/reference/page#Reading-              do token <- FB.getAppAccessToken-                 A.Object obj <- FB.getObject "/19292868552" [] (Just token)-                 let Just r =-                       flip A.parseMaybe () $-                       const $ (,) <$> obj A..:? "id" <*> obj A..:? "name"-                 return r-            val `shouldBe`-              ( Just "19292868552" :: Maybe Text-              , Just "Facebook for Developers" :: Maybe Text)-  describe' "getPage" $-    do it "works for FB Developers" $-         do runAuth $-              do token <- FB.getAppAccessToken-                 page <- FB.getPage_ (FB.Id "19292868552") [] (Just token)-                 FB.pageId page &?= (FB.Id "19292868552")-                 FB.pageName page &?= Just "Facebook for Developers"-                 FB.pageCategory page &?= Nothing-                 FB.pageIsPublished page &?= Nothing-                 FB.pageCanPost page &?= Nothing-                 FB.pagePhone page &?= Nothing-                 FB.pageCheckins page &?= Nothing-                 FB.pageWebsite page &?= Nothing-  describe' "listSubscriptions" $-    do it "returns something" $-         do runAuth $-              do token <- FB.getAppAccessToken-                 val <- FB.listSubscriptions token-                 length val `seq` return ()-  describe' "fetchNextPage" $-    do let fetchNextPageWorks :: FB.Pager A.Value-                              -> FB.FacebookT anyAuth (R.ResourceT IO) ()-           fetchNextPageWorks pager-             | isNothing (FB.pagerNext pager) = return ()-             | otherwise =-               FB.fetchNextPage pager >>= maybe not_ (\_ -> return ())-             where-               not_ =-                 fail "Pager had a next page but fetchNextPage didn't work."-       it "seems to work on a public list of comments" $-         do runAuth $+  describe' "getAppAccessToken" $ do+    it "works and returns a valid app access token" $+      runAuth $ do+        token <- FB.getAppAccessToken+        FB.isValid token #?= True+    it "throws a FacebookException on invalid credentials" $+      R.runResourceT $+      FB.runFacebookT invalidCredentials manager $ do+        ret <- E.try $ FB.getAppAccessToken+        case ret of+          Right token -> fail $ show token+          Left (_ :: FB.FacebookException) -> lift $ lift (return () :: IO ())+  describe' "setApiVersion" $ do+    it "Check default apiVersion" $ runNoAuth $ FB.getApiVersion #?= "v3.2"+    it "Change apiVersion" $+      (runNoAuth $ do+         FB.setApiVersion "v100"+         FB.getApiVersion) #?=+      "v100"+  describe' "isValid" $ do+    it "returns False on a clearly invalid user access token" $+      runNoAuth $ FB.isValid invalidUserAccessToken #?= False+    it "returns False on a clearly invalid app access token" $+      runNoAuth $ FB.isValid invalidAppAccessToken #?= False+  describe' "debugToken" $ do+    it "works on a test user access token" $ do+      runAuth $+        withTestUser D.def $ \testUser -> do+          Just testUserAccessTokenData <- return (FB.tuAccessToken testUser)+          appToken <- FB.getAppAccessToken+          ret <- FB.debugToken appToken testUserAccessTokenData+          now <- liftIO TI.getCurrentTime+          FB.dtAppId ret &?= Just (FB.appId creds)+          FB.dtAppName ret &?= Just (FB.appName creds)+          case FB.dtExpiresAt ret of+            Nothing -> fail "dtExpiresAt is Nothing"+            Just t -> compare t now &?= GT+          FB.dtIsValid ret &?= Just True+          case FB.dtIssuedAt ret of+            Nothing -> return () -- ok since it's a test user+            Just t -> compare t now &?= LT+          isJust (FB.dtScopes ret) &?= True+          FB.dtUserId ret &?= Just (FB.tuId testUser)+          case FB.dtAccessToken ret of+            Nothing -> fail "dtAccessToken is Nothing"+            Just t -> do+              let f :: FB.UserAccessToken+                    -> FB.FacebookT FB.Auth (R.ResourceT IO) ()+                  f (FB.UserAccessToken uid dt exps) = do+                    uid &?= FB.tuId testUser+                    dt &?= testUserAccessTokenData+                    Just exps &?= FB.dtExpiresAt ret+              f t+  describe' "getObject" $ do+    it "is able to fetch Facebook's own page" $ do+      val <-+        runAuth $ -- Needs permission now: https://developers.facebook.com/docs/graph-api/reference/page#Reading+         do+          token <- FB.getAppAccessToken+          A.Object obj <- FB.getObject "/220746347971798" [] (Just token)+          let Just r =+                flip A.parseMaybe () $+                const $ (,) <$> obj A..:? "id" <*> obj A..:? "name"+          return r+      val `shouldBe`+        (Just "220746347971798" :: Maybe Text, Just "Ruskin Bond" :: Maybe Text)+  describe' "getPage" $ do+    it "works for FB Developers" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        page <- FB.getPage_ (FB.Id "220746347971798") [] (Just token)+        FB.pageId page &?= (FB.Id "220746347971798")+        FB.pageName page &?= Just "Ruskin Bond"+        FB.pageCategory page &?= Nothing+        FB.pageIsPublished page &?= Nothing+        FB.pageCanPost page &?= Nothing+        FB.pagePhone page &?= Nothing+        FB.pageCheckins page &?= Nothing+        FB.pageWebsite page &?= Nothing+  describe' "listSubscriptions" $ do+    it "returns something" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        val <- FB.listSubscriptions token+        length val `seq` return ()+  describe' "fetchNextPage" $ do+    let fetchNextPageWorks ::+             FB.Pager A.Value -> FB.FacebookT anyAuth (R.ResourceT IO) ()+        fetchNextPageWorks pager+          | isNothing (FB.pagerNext pager) = return ()+          | otherwise = FB.fetchNextPage pager >>= maybe not_ (\_ -> return ())+          where+            not_ = fail "Pager had a next page but fetchNextPage didn't work."+    it "seems to work on a public list of comments" $ do+      runAuth $             -- Postid: https://www.facebook.com/nytimes/posts/10150628170209999             -- Page id found using this technique: https://www.facebook.com/help/community/question/?id=529591157094317-              do token <- FB.getAppAccessToken-                 fetchNextPageWorks =<<-                   FB.getObject-                     "/5281959998_10150628170209999/comments"-                     []-                     (Just token)-       it "seems to work on a private list of app insights" $-         do runAuth $-              do token <- FB.getAppAccessToken-                 fetchNextPageWorks =<<-                   FB.getObject-                     ("/" <> FB.appId creds <> "/app_insights/api_calls")-                     []-                     (Just token)-  describe' "fetchNextPage/fetchPreviousPage" $-    do let backAndForthWorks :: FB.Pager A.Value-                             -> FB.FacebookT anyAuth (R.ResourceT IO) ()-           backAndForthWorks pager = do-             pager2 <- FB.fetchNextPage pager-             case pager2 of-               Nothing -> True &?= True-               Just pager2' -> do-                 Just pager3 <- FB.fetchPreviousPage pager2'-                 pager3 &?= pager-       it "seems to work on a public list of comments" $-         do runAuth $-              do token <- FB.getAppAccessToken-                 backAndForthWorks =<<-                   FB.getObject-                     "/5281959998_10150628170209999/comments"-                     [("filter", "stream")]-                     (Just token)-       it "seems to work on a private list of app insights" $-         do runAuth $-              do token <- FB.getAppAccessToken-                 backAndForthWorks =<<-                   FB.getObject-                     ("/" <> FB.appId creds <> "/app_insights/api_calls")-                     []-                     (Just token)-  describe' "fetchAllNextPages" $-    do let hasAtLeast :: C.Source IO A.Value -> Int -> IO ()-           src `hasAtLeast` n = src C.$$ go n-             where-               go 0 = return ()-               go m = C.await >>= maybe not_ (\_ -> go (m - 1))-               not_ =-                 fail $-                 "Source does not have at least " ++ show n ++ " elements."-       it "seems to work on a public list of comments" $-         do runAuth $-              do token <- FB.getAppAccessToken-                 pager <--                   FB.getObject-                     "/63441126719_10154249531391720/comments"-                     []-                     (Just token)-                 src <- FB.fetchAllNextPages pager-                 liftIO $ src `hasAtLeast` 200 -- items-       it "seems to work on a private list of app insights" $-         do runAuth $-              do token <- FB.getAppAccessToken-                 pager <--                   FB.getObject-                     ("/" <> FB.appId creds <> "/app_insights/api_calls")-                     []-                     (Just token)-                 src <- FB.fetchAllNextPages pager-                 let firstPageElms = length (FB.pagerData pager)-                     hasNextPage = isJust (FB.pagerNext pager)-                 if hasNextPage-                   then liftIO $ src `hasAtLeast` (firstPageElms * 3) -- items-                   else return () -- fail "This isn't an insightful app =(."-  describe' "createTestUser/removeTestUser/getTestUser" $-    do it "creates and removes a new test user" $-         do runAuth $-              do token <- FB.getAppAccessToken+       do+        token <- FB.getAppAccessToken+        fetchNextPageWorks =<<+          FB.getObject "/5281959998_10150628170209999/comments" [] (Just token)+    it "seems to work on a private list of app insights" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        fetchNextPageWorks =<<+          FB.getObject+            ("/" <> FB.appId creds <> "/app_insights/api_calls")+            []+            (Just token)+  describe' "fetchNextPage/fetchPreviousPage" $ do+    let backAndForthWorks ::+             FB.Pager A.Value -> FB.FacebookT anyAuth (R.ResourceT IO) ()+        backAndForthWorks pager = do+          pager2 <- FB.fetchNextPage pager+          case pager2 of+            Nothing -> True &?= True+            Just pager2' -> do+              Just pager3 <- FB.fetchPreviousPage pager2'+              pager3 &?= pager+    it "seems to work on a public list of comments" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        backAndForthWorks =<<+          FB.getObject+            "/5281959998_10150628170209999/comments"+            [("filter", "stream")]+            (Just token)+    it "seems to work on a private list of app insights" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        backAndForthWorks =<<+          FB.getObject+            ("/" <> FB.appId creds <> "/app_insights/api_calls")+            []+            (Just token)+  describe' "fetchAllNextPages" $ do+    let hasAtLeast :: C.ConduitT () A.Value IO () -> Int -> IO ()+        src `hasAtLeast` n = C.runConduit $ src C..| go n+          where+            go 0 = return ()+            go m = C.await >>= maybe not_ (\_ -> go (m - 1))+            not_ =+              fail $ "Source does not have at least " ++ show n ++ " elements."+    it "seems to work on a public list of comments" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        pager <-+          FB.getObject "/63441126719_10154249531391720/comments" [] (Just token)+        src <- FB.fetchAllNextPages pager+        liftIO $ src `hasAtLeast` 200 -- items+    it "seems to work on a private list of app insights" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        pager <-+          FB.getObject+            ("/" <> FB.appId creds <> "/app_insights/api_calls")+            []+            (Just token)+        src <- FB.fetchAllNextPages pager+        let firstPageElms = length (FB.pagerData pager)+            hasNextPage = isJust (FB.pagerNext pager)+        if hasNextPage+          then liftIO $ src `hasAtLeast` (firstPageElms * 3) -- items+          else return () -- fail "This isn't an insightful app =(."+  describe' "createTestUser/removeTestUser/getTestUser" $ do+    it "creates and removes a new test user" $ do+      runAuth $ do+        token <- FB.getAppAccessToken                  -- New test user information-                 let installed =-                       FB.CreateTestUserInstalled-                         ["read_stream", "read_friendlists", "publish_stream"]-                     userInfo =-                       FB.CreateTestUser-                       { FB.ctuInstalled = installed-                       , FB.ctuName = Just "Gabriel"-                       , FB.ctuLocale = Just "en_US"-                       }+        let installed =+              FB.CreateTestUserInstalled+                ["read_stream", "read_friendlists", "publish_stream"]+            userInfo =+              FB.CreateTestUser+                { FB.ctuInstalled = installed+                , FB.ctuName = Just "Gabriel"+                , FB.ctuLocale = Just "en_US"+                }                  -- Create the test user-                 newTestUser <- FB.createTestUser userInfo token-                 let newTestUserToken =-                       (M.fromJust $ FB.incompleteTestUserAccessToken newTestUser)+        newTestUser <- FB.createTestUser userInfo token+        let newTestUserToken =+              (M.fromJust $ FB.incompleteTestUserAccessToken newTestUser)                  -- Get the created user-                 createdUser <--                   FB.getUser (FB.tuId newTestUser) [] (Just newTestUserToken)+        createdUser <-+          FB.getUser (FB.tuId newTestUser) [] (Just newTestUserToken)                  -- Remove the test user-                 removed <- FB.removeTestUser newTestUser token+        removed <- FB.removeTestUser newTestUser token                  -- Check user attributes-                 FB.userId createdUser &?= FB.tuId newTestUser-                 FB.userName createdUser &?= Just "Gabriel"-                 -- FB.userLocale createdUser &?= Just "en_US"   -- fix this test later+        FB.userId createdUser &?= FB.tuId newTestUser+        FB.userName createdUser &?= Just "Gabriel"+        -- FB.userLocale createdUser &?= Just "en_US" -- fix this test later                  -- Check if the token is valid-                 FB.isValid newTestUserToken #?= False-                 removed &?= True-  describe' "makeFriendConn" $-    do it "creates two new test users, makes them friends and deletes them" $-         do runAuth $-              withTestUser D.def $-              \testUser1 ->-                 withTestUser D.def $-                 \testUser2 -> do-                   let Just tokenUser1 = FB.incompleteTestUserAccessToken testUser1-                   let Just tokenUser2 = FB.incompleteTestUserAccessToken testUser2+        FB.isValid newTestUserToken #?= False+        removed &?= True+  describe' "makeFriendConn" $ do+    it "creates two new test users, makes them friends and deletes them" $ do+      runAuth $+        withTestUser D.def $ \testUser1 ->+          withTestUser D.def $ \testUser2 -> do+            let Just tokenUser1 = FB.incompleteTestUserAccessToken testUser1+            let Just tokenUser2 = FB.incompleteTestUserAccessToken testUser2                    -- Check if the new test users' tokens are valid.-                   FB.isValid tokenUser1 #?= True-                   FB.isValid tokenUser2 #?= True+            FB.isValid tokenUser1 #?= True+            FB.isValid tokenUser2 #?= True                    -- Create a friend connection between the new test users.-                   FB.makeFriendConn testUser1 testUser2+            FB.makeFriendConn testUser1 testUser2                    -- Verify that one is a friend of the other.-                   user1 <- FB.getUser (FB.tuId testUser1) [] (Just tokenUser1)-                   user2 <- FB.getUser (FB.tuId testUser2) [] (Just tokenUser2)-                   friends1 <- FB.getUserFriends (FB.tuId testUser1) [] tokenUser1-                   friends2 <- FB.getUserFriends (FB.tuId testUser2) [] tokenUser2-                   FB.pagerData friends1 &?=-                     [ FB.Friend-                         (FB.tuId testUser2)-                         (M.fromJust (FB.userName user2))-                     ]-                   FB.pagerData friends2 &?=-                     [ FB.Friend-                         (FB.tuId testUser1)-                         (M.fromJust (FB.userName user1))-                     ]-  describe' "getTestUsers" $-    do it "gets a list of test users" $-         do runAuth $-              do token <- FB.getAppAccessToken-                 pager <- FB.getTestUsers token-                 src <- FB.fetchAllNextPages pager-                 oldList <- liftIO $ R.runResourceT $ src C.$$ CL.consume-                 withTestUser D.def $-                   \testUser -> do-                     newList <- FB.pagerData <$> FB.getTestUsers token-                     let newList' = map FB.tuId newList-                         oldList' = map FB.tuId oldList-                     ((FB.tuId testUser) `elem` (newList' \\ oldList')) &?= True+            user1 <- FB.getUser (FB.tuId testUser1) [] (Just tokenUser1)+            user2 <- FB.getUser (FB.tuId testUser2) [] (Just tokenUser2)+            friends1 <- FB.getUserFriends (FB.tuId testUser1) [] tokenUser1+            friends2 <- FB.getUserFriends (FB.tuId testUser2) [] tokenUser2+            FB.pagerData friends1 &?=+              [FB.Friend (FB.tuId testUser2) (M.fromJust (FB.userName user2))]+            FB.pagerData friends2 &?=+              [FB.Friend (FB.tuId testUser1) (M.fromJust (FB.userName user1))]+  describe' "getTestUsers" $ do+    it "gets a list of test users" $ do+      runAuth $ do+        token <- FB.getAppAccessToken+        pager <- FB.getTestUsers token+        src <- FB.fetchAllNextPages pager+        oldList <- liftIO $ R.runResourceT $ C.runConduit $ src C..| CL.consume+        withTestUser D.def $ \testUser -> do+          newList <- FB.pagerData <$> FB.getTestUsers token+          let newList' = map FB.tuId newList+              oldList' = map FB.tuId oldList+          ((FB.tuId testUser) `elem` (newList' \\ oldList')) &?= True  newtype PageName =   PageName Text@@ -375,138 +360,140 @@  libraryTests :: H.Manager -> Spec libraryTests manager = do-  describe "SimpleType" $-    do it "works for Bool" $ (map FB.encodeFbParam [True, False]) @?= ["1", "0"]-       let day = TI.fromGregorian 2012 12 21-           time = TI.TimeOfDay 11 37 22-           diffTime = TI.secondsToDiffTime (11 * 3600 + 37 * 60)-           utcTime = TI.UTCTime day diffTime-           localTime = TI.LocalTime day time-           zonedTime = TI.ZonedTime localTime (TI.minutesToTimeZone 30)-       it "works for Day" $ FB.encodeFbParam day @?= "2012-12-21"-       it "works for UTCTime" $ FB.encodeFbParam utcTime @?= "20121221T1137Z"-       it "works for ZonedTime" $-         FB.encodeFbParam zonedTime @?= "20121221T1107Z"-       let propShowRead-             :: (Show a, Read a, Eq a, FB.SimpleType a)-             => a -> Bool-           propShowRead x = read (B.unpack $ FB.encodeFbParam x) == x-       prop "works for Float" (propShowRead :: Float -> Bool)-       prop "works for Double" (propShowRead :: Double -> Bool)-       prop "works for Int" (propShowRead :: Int -> Bool)-       prop "works for Int8" (propShowRead :: Int8 -> Bool)-       prop "works for Int16" (propShowRead :: Int16 -> Bool)-       prop "works for Int32" (propShowRead :: Int32 -> Bool)-       prop "works for Int64" (propShowRead :: Int64 -> Bool)-       prop "works for Word" (propShowRead :: Word -> Bool)-       prop "works for Word8" (propShowRead :: Word8 -> Bool)-       prop "works for Word16" (propShowRead :: Word16 -> Bool)-       prop "works for Word32" (propShowRead :: Word32 -> Bool)-       prop "works for Word64" (propShowRead :: Word64 -> Bool)-       let propShowReadL-             :: (Show a, Read a, Eq a, FB.SimpleType a)-             => [a] -> Bool-           propShowReadL x =-             read ('[' : B.unpack (FB.encodeFbParam x) ++ "]") == x-       prop "works for [Float]" (propShowReadL :: [Float] -> Bool)-       prop "works for [Double]" (propShowReadL :: [Double] -> Bool)-       prop "works for [Int]" (propShowReadL :: [Int] -> Bool)-       prop "works for [Int8]" (propShowReadL :: [Int8] -> Bool)-       prop "works for [Int16]" (propShowReadL :: [Int16] -> Bool)-       prop "works for [Int32]" (propShowReadL :: [Int32] -> Bool)-       prop "works for [Int64]" (propShowReadL :: [Int64] -> Bool)-       prop "works for [Word]" (propShowReadL :: [Word] -> Bool)-       prop "works for [Word8]" (propShowReadL :: [Word8] -> Bool)-       prop "works for [Word16]" (propShowReadL :: [Word16] -> Bool)-       prop "works for [Word32]" (propShowReadL :: [Word32] -> Bool)-       prop "works for [Word64]" (propShowReadL :: [Word64] -> Bool)-       prop "works for Text" (\t -> FB.encodeFbParam t == TE.encodeUtf8 t)-       prop "works for Id" $-         \i ->-            let toId :: Int -> FB.Id-                toId = FB.Id . T.pack . show-                j = abs i-            in FB.encodeFbParam (toId j) == FB.encodeFbParam j-  describe "parseSignedRequest" $-    do let exampleSig, exampleData :: B.ByteString-           exampleSig = "vlXgu64BQGFSQrY0ZcJBZASMvYvTHu9GQ0YM9rjPSso"-           exampleData =-             "eyJhbGdvcml0aG0iOiJITUFDLVNIQTI1NiIsIjAiOiJwYXlsb2FkIn0"-           exampleCreds = FB.Credentials "name" "id" "secret"-           runExampleAuth :: FB.FacebookT FB.Auth (R.ResourceT IO) a -> IO a-           runExampleAuth = R.runResourceT . FB.runFacebookT exampleCreds manager-       it "works for Facebook example" $-         do runExampleAuth $-              do ret <--                   FB.parseSignedRequest-                     (B.concat [exampleSig, ".", exampleData])-                 ret &?=-                   Just-                     (A.object-                        [ "algorithm" A..= ("HMAC-SHA256" :: Text)-                        , "0" A..= ("payload" :: Text)-                        ])-       it "fails to parse the Facebook example when signature is corrupted" $-         do let corruptedSig = B.cons 'a' (B.tail exampleSig)-            runExampleAuth $-              do ret <--                   FB.parseSignedRequest-                     (B.concat [corruptedSig, ".", exampleData])-                 ret &?= (Nothing :: Maybe A.Value)-  describe "FQLTime" $-    do it "seems to work" $-         do let input = "[1348678357]"-                output = FB.FQLTime (read "2012-09-26 16:52:37 UTC")-            A.decode input @?= Just [output]-  describe "FbUTCTime" $-    do let output = FB.FbUTCTime (read "2012-09-26 16:52:37 UTC")-       it "seems to work (string)" $-         do let input = "[\"2012-09-26T16:52:37+0000\"]"-            A.decode input @?= Just [output]-       it "seems to work (unix epoch)" $-         do let input = "[1348678357]"-            A.decode input @?= Just [output]-  describe "FQLList" $-    do let j :: [Int] -> Maybe (FB.FQLList Int)-           j = Just . FB.FQLList-       it "parses []" $ do A.decode "[]" @?= j []-       it "parses {}" $ do A.decode "{}" @?= j []-       it "parses [1234]" $ do A.decode "[1234]" @?= j [1234]-       it "parses {\"1234\": 1234}" $-         do A.decode "{\"1234\": 1234}" @?= j [1234]-  describe "FQLObject" $-    do let j :: [(Text, Int)] -> Maybe (FB.FQLObject (Map.Map Text Int))-           j = Just . FB.FQLObject . Map.fromList-       it "parses []" $ do A.decode "[]" @?= j []-       it "parses {}" $ do A.decode "{}" @?= j []-       it "parses {\"abc\": 1234}" $-         do A.decode "{\"abc\": 1234}" @?= j [("abc", 1234)]-       it "does not parse [1234]" $-         do A.decode "[1234]" @?= (Nothing `asTypeOf` j [])-  describe "Id" $-    do it "can be parsed from a string" $-         do A.decode "[\"1234\"]" @?= Just [FB.Id "1234"]-       it "can be parsed from an integer" $-         do A.decode "[1234]" @?= Just [FB.Id "1234"]-       it "can be parsed from an object with a string" $-         do A.decode "{\"id\": \"1234\"}" @?= Just (FB.Id "1234")-       it "can be parsed from an object with an integer" $-         do A.decode "{\"id\": 1234}" @?= Just (FB.Id "1234")-  describe "AccessToken" $-    do it "can be round-tripped with ToJSON/FromJSON (UserKind)" $-         do A.eitherDecode (A.encode invalidUserAccessToken) @?= Right invalidUserAccessToken-       it "can be round-tripped with ToJSON/FromJSON (AppKind)" $-         do A.eitherDecode (A.encode invalidAppAccessToken) @?= Right invalidAppAccessToken+  describe "SimpleType" $ do+    it "works for Bool" $ (map FB.encodeFbParam [True, False]) @?= ["1", "0"]+    let day = TI.fromGregorian 2012 12 21+        time = TI.TimeOfDay 11 37 22+        diffTime = TI.secondsToDiffTime (11 * 3600 + 37 * 60)+        utcTime = TI.UTCTime day diffTime+        localTime = TI.LocalTime day time+        zonedTime = TI.ZonedTime localTime (TI.minutesToTimeZone 30)+    it "works for Day" $ FB.encodeFbParam day @?= "2012-12-21"+    it "works for UTCTime" $ FB.encodeFbParam utcTime @?= "20121221T1137Z"+    it "works for ZonedTime" $ FB.encodeFbParam zonedTime @?= "20121221T1107Z"+    let propShowRead :: (Show a, Read a, Eq a, FB.SimpleType a) => a -> Bool+        propShowRead x = read (B.unpack $ FB.encodeFbParam x) == x+    prop "works for Float" (propShowRead :: Float -> Bool)+    prop "works for Double" (propShowRead :: Double -> Bool)+    prop "works for Int" (propShowRead :: Int -> Bool)+    prop "works for Int8" (propShowRead :: Int8 -> Bool)+    prop "works for Int16" (propShowRead :: Int16 -> Bool)+    prop "works for Int32" (propShowRead :: Int32 -> Bool)+    prop "works for Int64" (propShowRead :: Int64 -> Bool)+    prop "works for Word" (propShowRead :: Word -> Bool)+    prop "works for Word8" (propShowRead :: Word8 -> Bool)+    prop "works for Word16" (propShowRead :: Word16 -> Bool)+    prop "works for Word32" (propShowRead :: Word32 -> Bool)+    prop "works for Word64" (propShowRead :: Word64 -> Bool)+    let propShowReadL :: (Show a, Read a, Eq a, FB.SimpleType a) => [a] -> Bool+        propShowReadL x = read ('[' : B.unpack (FB.encodeFbParam x) ++ "]") == x+    prop "works for [Float]" (propShowReadL :: [Float] -> Bool)+    prop "works for [Double]" (propShowReadL :: [Double] -> Bool)+    prop "works for [Int]" (propShowReadL :: [Int] -> Bool)+    prop "works for [Int8]" (propShowReadL :: [Int8] -> Bool)+    prop "works for [Int16]" (propShowReadL :: [Int16] -> Bool)+    prop "works for [Int32]" (propShowReadL :: [Int32] -> Bool)+    prop "works for [Int64]" (propShowReadL :: [Int64] -> Bool)+    prop "works for [Word]" (propShowReadL :: [Word] -> Bool)+    prop "works for [Word8]" (propShowReadL :: [Word8] -> Bool)+    prop "works for [Word16]" (propShowReadL :: [Word16] -> Bool)+    prop "works for [Word32]" (propShowReadL :: [Word32] -> Bool)+    prop "works for [Word64]" (propShowReadL :: [Word64] -> Bool)+    prop "works for Text" (\t -> FB.encodeFbParam t == TE.encodeUtf8 t)+    prop "works for Id" $ \i ->+      let toId :: Int -> FB.Id+          toId = FB.Id . T.pack . show+          j = abs i+       in FB.encodeFbParam (toId j) == FB.encodeFbParam j+  describe "parseSignedRequest" $ do+    let exampleSig, exampleData :: B.ByteString+        exampleSig = "vlXgu64BQGFSQrY0ZcJBZASMvYvTHu9GQ0YM9rjPSso"+        exampleData = "eyJhbGdvcml0aG0iOiJITUFDLVNIQTI1NiIsIjAiOiJwYXlsb2FkIn0"+        exampleCreds = FB.Credentials "name" "id" "secret" False+        runExampleAuth :: FB.FacebookT FB.Auth (R.ResourceT IO) a -> IO a+        runExampleAuth = R.runResourceT . FB.runFacebookT exampleCreds manager+    it "works for Facebook example" $ do+      runExampleAuth $ do+        ret <- FB.parseSignedRequest (B.concat [exampleSig, ".", exampleData])+        ret &?=+          Just+            (A.object+               [ "algorithm" A..= ("HMAC-SHA256" :: Text)+               , "0" A..= ("payload" :: Text)+               ])+    it "fails to parse the Facebook example when signature is corrupted" $ do+      let corruptedSig = B.cons 'a' (B.tail exampleSig)+      runExampleAuth $ do+        ret <- FB.parseSignedRequest (B.concat [corruptedSig, ".", exampleData])+        ret &?= (Nothing :: Maybe A.Value)+  describe "addAppSecretProof" $ do+    it "appends appsecret_proof to the query when passing an access token" $ do+      now <- liftIO TI.getCurrentTime+      let token = FB.UserAccessToken "id" "token" now+          query = [("test", "whatever")]+          secretProofQ creds = FB.makeAppSecretProof creds (Just token)+      creds <- getCredentials+      FB.addAppSecretProof creds (Just token) query @?= secretProofQ creds <>+        query+  describe "FQLTime" $ do+    it "seems to work" $ do+      let input = "[1348678357]"+          output = FB.FQLTime (read "2012-09-26 16:52:37 UTC")+      A.decode input @?= Just [output]+  describe "FbUTCTime" $ do+    let output = FB.FbUTCTime (read "2012-09-26 16:52:37 UTC")+    it "seems to work (string)" $ do+      let input = "[\"2012-09-26T16:52:37+0000\"]"+      A.decode input @?= Just [output]+    it "seems to work (unix epoch)" $ do+      let input = "[1348678357]"+      A.decode input @?= Just [output]+  describe "FQLList" $ do+    let j :: [Int] -> Maybe (FB.FQLList Int)+        j = Just . FB.FQLList+    it "parses []" $ do A.decode "[]" @?= j []+    it "parses {}" $ do A.decode "{}" @?= j []+    it "parses [1234]" $ do A.decode "[1234]" @?= j [1234]+    it "parses {\"1234\": 1234}" $ do A.decode "{\"1234\": 1234}" @?= j [1234]+  describe "FQLObject" $ do+    let j :: [(Text, Int)] -> Maybe (FB.FQLObject (Map.Map Text Int))+        j = Just . FB.FQLObject . Map.fromList+    it "parses []" $ do A.decode "[]" @?= j []+    it "parses {}" $ do A.decode "{}" @?= j []+    it "parses {\"abc\": 1234}" $ do+      A.decode "{\"abc\": 1234}" @?= j [("abc", 1234)]+    it "does not parse [1234]" $ do+      A.decode "[1234]" @?= (Nothing `asTypeOf` j [])+  describe "Id" $ do+    it "can be parsed from a string" $ do+      A.decode "[\"1234\"]" @?= Just [FB.Id "1234"]+    it "can be parsed from an integer" $ do+      A.decode "[1234]" @?= Just [FB.Id "1234"]+    it "can be parsed from an object with a string" $ do+      A.decode "{\"id\": \"1234\"}" @?= Just (FB.Id "1234")+    it "can be parsed from an object with an integer" $ do+      A.decode "{\"id\": 1234}" @?= Just (FB.Id "1234")+  describe "AccessToken" $ do+    it "can be round-tripped with ToJSON/FromJSON (UserKind)" $ do+      A.eitherDecode (A.encode invalidUserAccessToken) @?=+        Right invalidUserAccessToken+    it "can be round-tripped with ToJSON/FromJSON (AppKind)" $ do+      A.eitherDecode (A.encode invalidAppAccessToken) @?=+        Right invalidAppAccessToken+  describe "makeAppSecretProof" $ do+    it "generates correct hmac" $+      let creds = FB.Credentials "name" "id" "secret" True+          uToken = FB.UserAccessToken (FB.Id "user") "accesstoken" undefined+          proof = FB.makeAppSecretProof creds $ Just uToken+          expectedProof =+            "65138b7ea24e641d38c91befa22b6281953980d1bfd0322956bc29959e1a910c"+       in proof @?= [("appsecret_proof", expectedProof)]  -- Wrappers for HUnit operators using MonadIO-(&?=)-  :: (Eq a, Show a, MonadIO m)-  => a -> a -> m ()+(&?=) :: (Eq a, Show a, MonadIO m) => a -> a -> m () v &?= e = liftIO (v @?= e) -( #?= )-  :: (Eq a, Show a, MonadIO m)-  => m a -> a -> m ()+(#?=) :: (Eq a, Show a, MonadIO m) => m a -> a -> m () m #?= e = m >>= (&?= e)  -- | Sad, orphan instance.@@ -516,8 +503,8 @@  -- | Perform an action with a new test user. Remove the new test user -- after the action is performed.-withTestUser-  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+withTestUser ::+     (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => FB.CreateTestUser   -> (FB.TestUser -> FB.FacebookT FB.Auth m a)   -> FB.FacebookT FB.Auth m a