fb 1.1.1 → 1.2.0

raw patch · 18 files changed

+505/−524 lines, 18 filesdep +unliftiodep +unliftio-coredep −lifted-basedep −monad-controldep ~basedep ~conduitdep ~conduit-extraPVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio, unliftio-core

Dependencies removed: lifted-base, monad-control

Dependency ranges changed: base, conduit, conduit-extra, http-client, http-conduit, monad-logger, resourcet

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−1
• fb.cabal +104/−106
• src/Facebook/Auth.hs +16/−21
• src/Facebook/Base.hs +19/−32
• src/Facebook/FQL.hs +38/−35
• src/Facebook/Graph.hs +9/−8
• src/Facebook/Monad.hs +96/−93
• src/Facebook/Object/Action.hs +35/−30
• src/Facebook/Object/Checkin.hs +6/−5
• src/Facebook/Object/FriendList.hs +6/−5
• src/Facebook/Object/Order.hs +5/−7
• src/Facebook/Object/Page.hs +7/−9
• src/Facebook/Object/User.hs +8/−10
• src/Facebook/Pager.hs +15/−24
• src/Facebook/RealTime.hs +89/−98
• src/Facebook/TestUsers.hs +13/−12
• src/Facebook/Types.hs +6/−1
• tests/Main.hs +25/−27

@@ -1,4 +1,11 @@-# Version+# Version 1.2.0++* Rewrote fb for conduit-1.3.0+* Fixed various warnings and did general cleanup+* Fixed fetchNextPage/fetchPreviousPage test by adding ("filter", "stream") for comments api.+* Made lower bound of http-conduit to 2.3.0++# Version 1.1.1  * Make versioned call. By default now it uses `v2.8. * `disassociateTestuser` function added.

@@ -1,131 +1,129 @@-name:              fb-version:           1.1.1-license:           BSD3-license-file:      LICENSE-author:            Felipe Lessa, Sibi-maintainer:        Sibi <sibi@psibi.in>-copyright:         (c) Prowdsponsor-synopsis:          Bindings to Facebook's API.-category:          Web-stability:         Experimental-cabal-version:     >= 1.8-build-type:        Simple-homepage:          https://github.com/psibi/fb-bug-reports:       https://github.com/psibi/fb/issues+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 6cdcc7bbe1b414ac426e06da9807fe668b27be226182b4a96c6e237a783d6e57 -description:-  This package exports bindings to Facebook's APIs (see-  <http://developers.facebook.com/>).  Does not have any external-  dependencies and tries to use as little resources (such as-  memory, sockets and CPU) as possible by using packages such as-  @aeson@, @attoparsec@, @bytestring@, @conduit@, @http-conduit@,-  @text@ and others.-  .-  While we would like to have a complete binding to Facebook's-  API, this package is being developed on demand.  If you need-  something that has not been implemented yet, please send a pull-  request or file an issue on GitHub-  (<https://github.com/psibi/fb/issues>).+name:           fb+version:        1.2.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+                dependencies and tries to use as little resources (such as+                memory, sockets and CPU) as possible by using packages such as+                @aeson@, @attoparsec@, @bytestring@, @conduit@, @http-conduit@,+                @text@ and others.+                .+                While we would like to have a complete binding to Facebook's+                API, this package is being developed on demand.  If you need+                something that has not been implemented yet, please send a pull+                request or file an issue on GitHub+                (<https://github.com/psibi/fb/issues>).+category:       Web+stability:      Experimental+homepage:       https://github.com/psibi/fb+bug-reports:    https://github.com/psibi/fb/issues+author:         Felipe Lessa, Sibi Prabakaran+maintainer:     Sibi <sibi@psibi.in>+copyright:      Felipe Lessa and Sibi Prabakaran+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10  extra-source-files:-  tests/Main.hs-  tests/tryIt.hs-  example.hs-  README.md-  CHANGELOG.md-+    CHANGELOG.md+    example.hs+    README.md+    tests/Main.hs+    tests/tryIt.hs  source-repository head-  type:     git+  type: git   location: git@github.com:psibi/fb.git - flag debug-  default: False   description: Print debugging info.+  manual: False+  default: False  library-  hs-source-dirs: src+  hs-source-dirs:+      src   ghc-options: -Wall-  exposed-modules:-    Facebook-  other-modules:-    Facebook.Types-    Facebook.Monad-    Facebook.Base-    Facebook.Auth-    Facebook.Pager-    Facebook.Graph-    Facebook.Object.Action-    Facebook.Object.FriendList-    Facebook.Object.Checkin-    Facebook.Object.User-    Facebook.Object.Page-    Facebook.Object.Order-    Facebook.RealTime-    Facebook.FQL-    Facebook.TestUsers   build-depends:-      base                 >= 4       && < 5-    , lifted-base          >= 0.1     && < 0.3-    , bytestring           >= 0.9     && < 0.11-    , text                 >= 0.11    && < 1.3-    , transformers         >= 0.2     && < 0.6-    , transformers-base-    , monad-control-    , resourcet+      aeson >=0.8.0.2+    , attoparsec >=0.10.4 && <0.14+    , base >=4 && <5+    , base16-bytestring >=0.1+    , base64-bytestring >=0.1.1+    , bytestring >=0.9 && <0.11+    , cereal >=0.3 && <0.6+    , conduit >=1.3.0+    , conduit-extra >=1.3.0+    , crypto-api >=0.11 && <0.14+    , cryptohash >=0.7+    , cryptohash-cryptoapi ==0.1.*     , data-default+    , http-client >=0.4.30+    , http-conduit >=2.3.0     , http-types-    , http-conduit         >= 2.0-    , http-client          >= 0.4.18.1-    , attoparsec           >= 0.10.4  && < 0.14-    , unordered-containers-    , aeson                >= 0.8.0.2-    , base16-bytestring    >= 0.1-    , base64-bytestring    >= 0.1.1-    , time                 >= 1.4+    , monad-logger >=0.3.28     , old-locale-    , cereal               >= 0.3     && < 0.6-    , crypto-api           >= 0.11    && < 0.14-    , cryptohash           >= 0.7-    , cryptohash-cryptoapi == 0.1.*-    , monad-logger         >= 0.3-    , conduit-    , conduit-extra--  extensions:-    DeriveDataTypeable-    EmptyDataDecls-    OverloadedStrings-    GADTs-    StandaloneDeriving-    ScopedTypeVariables-    GeneralizedNewtypeDeriving-    TypeFamilies-    FlexibleInstances-    MultiParamTypeClasses-    CPP+    , resourcet >=1.2.0+    , text >=0.11 && <1.3+    , time >=1.4+    , transformers >=0.2 && <0.6+    , transformers-base+    , unliftio+    , unliftio-core+    , unordered-containers   if flag(debug)     cpp-options: -DDEBUG+  exposed-modules:+      Facebook+  other-modules:+      Facebook.Auth+      Facebook.Base+      Facebook.FQL+      Facebook.Graph+      Facebook.Monad+      Facebook.Object.Action+      Facebook.Object.Checkin+      Facebook.Object.FriendList+      Facebook.Object.Order+      Facebook.Object.Page+      Facebook.Object.User+      Facebook.Pager+      Facebook.RealTime+      Facebook.TestUsers+      Facebook.Types+      Paths_fb+  default-language: Haskell2010  test-suite runtests   type: exitcode-stdio-1.0-  ghc-options:    -Wall -fno-warn-orphans-  hs-source-dirs: tests-  main-is:        Main.hs+  main-is: Main.hs+  hs-source-dirs:+      tests+  ghc-options: -Wall -fno-warn-orphans   build-depends:-      -- Library dependencies used on the tests.  No need to-      -- specify versions since they'll use the same as above.-      base, lifted-base, transformers, bytestring, resourcet,-      conduit, http-conduit, text, time, aeson, monad-control--      -- Test-only dependencies+      HUnit+    , QuickCheck+    , aeson+    , base+    , bytestring+    , conduit     , containers     , data-default-    , HUnit-    , QuickCheck-    , hspec     , fb-  extensions:-    TypeFamilies-    ScopedTypeVariables+    , hspec+    , http-conduit+    , resourcet+    , text+    , time+    , transformers+    , unliftio+  other-modules:+      Paths_fb+  default-language: Haskell2010

@@ -1,5 +1,8 @@-{-# LANGUAGE FlexibleContexts, GADTs, ScopedTypeVariables,-  OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}  module Facebook.Auth   ( getAppAccessToken@@ -19,9 +22,8 @@ #if __GLASGOW_HASKELL__ <= 784 import Control.Applicative #endif-import Control.Monad (guard, join, liftM, mzero)+import Control.Monad (guard, liftM, mzero) import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Maybe (MaybeT(..)) import Crypto.Classes (constTimeEq) import Crypto.Hash.CryptoAPI (SHA256)@@ -34,27 +36,20 @@ import Data.Typeable (Typeable) import Data.String (IsString(..)) -import qualified Control.Exception.Lifted as E+import qualified UnliftIO.Exception as E import qualified Control.Monad.Trans.Resource as R import qualified Data.Aeson as AE import qualified Data.Aeson.Types as AE import qualified Data.Attoparsec.ByteString.Char8 as AB-import qualified Data.Attoparsec.Text as A import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL 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 import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE-import qualified Network.HTTP.Conduit as H import qualified Network.HTTP.Types as HT-import Data.Text (Text)  import Facebook.Types import Facebook.Base@@ -64,7 +59,7 @@ -- credentials. -- Ref: https://developers.facebook.com/docs/facebook-login/manually-build-a-login-flow getAppAccessToken-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => FacebookT Auth m AppAccessToken getAppAccessToken =   runResourceInFb $@@ -77,7 +72,7 @@      case AE.parseMaybe tokenParser token of        Just appToken -> return $ AppAccessToken appToken        _ ->-         E.throw $+         E.throwIO $          FbLibraryException ("Unable to parse: " <> (T.pack $ show token))   where     tokenParser :: AE.Value -> AE.Parser AccessTokenData@@ -125,7 +120,7 @@ -- to this function that will complete the user authentication -- flow and give you an @'UserAccessToken'@. getUserAccessTokenStep2-  :: (MonadBaseControl IO m, R.MonadResource m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => RedirectUrl -- ^ Should be exactly the same      -- as in 'getUserAccessTokenStep1'.   -> [Argument] -- ^ Query parameters.@@ -159,7 +154,7 @@               ["error", "error_reason", "error_description"]           errorType = T.concat [t error_, " (", t errorReason, ")"]           t = TE.decodeUtf8With TE.lenientDecode-      in E.throw $ 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@@ -175,14 +170,14 @@   where     toExpire expt = addUTCTime (fromIntegral expt) now     tokenParser :: AE.Value -> AE.Parser (AccessTokenData, UTCTime)-    tokenParser val =+    tokenParser value =       AE.withObject         "accessToken"         (\obj -> do            (token :: Text) <- obj AE..: "access_token"            (expires_in :: Int) <- obj AE..: "expires_in"            return (token, toExpire expires_in))-        val+        value  -- | The URL an user should be redirected to in order to log them -- out of their Facebook session.  Facebook will then redirect@@ -269,7 +264,7 @@ -- case of an user access token, they may have changed their -- password, logged out from Facebook or blocked your app. isValid-  :: (MonadBaseControl IO m, R.MonadResource m)+  :: (R.MonadResource m, R.MonadUnliftIO m)   => AccessToken anyKind -> FacebookT anyAuth m Bool isValid token = do   expired <- hasExpired token@@ -302,7 +297,7 @@ -- can't assume this).  Note that expired access tokens can't be -- extended, only valid tokens. extendUserAccessToken-  :: (MonadBaseControl IO m, R.MonadResource m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => UserAccessToken   -> FacebookT Auth m (Either FacebookException UserAccessToken) extendUserAccessToken token@(UserAccessToken uid data_ _) = do@@ -399,7 +394,7 @@  -- | Get detailed information about an access token. debugToken-  :: (MonadBaseControl IO m, R.MonadResource m)+  :: (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

@@ -1,4 +1,7 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings, CPP #-}+{-#LANGUAGE DeriveDataTypeable#-}+{-#LANGUAGE FlexibleContexts#-}+{-#LANGUAGE OverloadedStrings#-}+{-#LANGUAGE CPP#-} module Facebook.Base     ( fbreq     , ToSimpleQuery(..)@@ -19,14 +22,14 @@ import Data.Text (Text) import Data.Typeable (Typeable) -import qualified Control.Exception.Lifted as E+import qualified UnliftIO.Exception as E import Control.Monad.Trans.Class (MonadTrans)-import Control.Monad.Trans.Control (MonadBaseControl) import qualified Control.Monad.Trans.Resource as R import qualified Data.Aeson as A import qualified Data.Attoparsec.ByteString.Char8 as AT import qualified Data.ByteString as B import qualified Data.Conduit as C+import Data.Conduit ((.|)) import qualified Data.Conduit.Attoparsec as C import qualified Data.Conduit.List as CL import qualified Data.Conduit.Binary as CB@@ -35,9 +38,6 @@ import qualified Network.HTTP.Conduit as H import qualified Network.HTTP.Types as HT import qualified Data.ByteString.Lazy as L-#if !MIN_VERSION_http_client(0,4,30)-import Data.Default (def)-#endif #if DEBUG import Control.Monad.IO.Class (MonadIO, liftIO) import Text.Printf (printf)@@ -62,7 +62,6 @@       let host = case tier of                    Production -> "graph.facebook.com"                    Beta ->  "graph.beta.facebook.com"-#if MIN_VERSION_http_client(0,4,30)       in H.defaultRequest { H.secure        = True              , H.host          = host              , H.port          = 443@@ -77,18 +76,6 @@              , H.responseTimeout = Just 120000000 -- 2 minutes #endif              }-#else-      in def { H.secure        = True-             , H.host          = host-             , H.port          = 443-             , H.path          = TE.encodeUtf8 path-             , H.redirectCount = 3-             , H.queryString   =-                 HT.renderSimpleQuery False $-                 maybe id tsq mtoken query-             , H.responseTimeout = Just 120000000 -- 2 minutes-             }-#endif   -- | Internal class for types that may be passed on queries to@@ -110,12 +97,12 @@ -- | Converts a plain 'H.Response' coming from 'H.http' into a -- JSON value. asJson :: (MonadIO m, MonadTrans t, R.MonadThrow m, A.FromJSON a) =>-          H.Response (C.ResumableSource m ByteString)+          H.Response (C.ConduitT () ByteString m ())        -> t m a asJson = lift . asJsonHelper  asJsonHelper :: (MonadIO m, R.MonadThrow m, A.FromJSON a) =>-                H.Response (C.ResumableSource m ByteString)+                H.Response (C.ConduitT () ByteString m ())              -> m a asJsonHelper response = do #if DEBUG@@ -123,12 +110,12 @@   _ <- liftIO $ printf "asJsonHelper: %s\n" (show bs)   val <- either (fail . ("asJsonHelper: A.decode returned " ++)) return (A.eitherDecode bs) #else-  val <- H.responseBody response C.$$+- C.sinkParser A.json'+  val <- C.runConduit $ (H.responseBody response) .| C.sinkParser A.json' #endif   case A.fromJSON val of     A.Success r -> return r     A.Error str ->-        E.throw $ FbLibraryException $ T.concat+        E.throwIO $ FbLibraryException $ T.concat              [ "Facebook.Base.asJson: could not parse "              , " Facebook's response as a JSON value ("              , T.pack str, ")" ]@@ -136,9 +123,9 @@  -- | Converts a plain 'H.Response' into a string 'ByteString'. asBS :: (Monad m) =>-        H.Response (C.ResumableSource m ByteString)+        H.Response (C.ConduitT () ByteString m ())      -> FacebookT anyAuth m ByteString-asBS response = lift $ H.responseBody response C.$$+- fmap B.concat CL.consume+asBS response = lift $ C.runConduit $ H.responseBody response .| fmap B.concat CL.consume   -- | An exception that may be thrown by functions on this@@ -163,17 +150,17 @@  -- | Same as 'H.http', but tries to parse errors and throw -- meaningful 'FacebookException'@s@.-fbhttp :: (MonadBaseControl IO m, R.MonadResource m) =>+fbhttp :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m) =>           H.Request-       -> FacebookT anyAuth m (H.Response (C.ResumableSource m ByteString))+       -> FacebookT anyAuth m (H.Response (C.ConduitT () ByteString m ())) fbhttp req = do   manager <- getManager   lift (fbhttpHelper manager req) -fbhttpHelper :: (MonadBaseControl IO m, R.MonadResource m) =>+fbhttpHelper :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m) =>                 H.Manager              -> H.Request-             -> m (H.Response (C.ResumableSource m ByteString))+             -> m (H.Response (C.ConduitT () ByteString m ())) fbhttpHelper manager req = do #if MIN_VERSION_http_client(0,5,0)   let req' = req { H.checkResponse = \_ _ -> return () }@@ -193,7 +180,7 @@     then return response     else do #if MIN_VERSION_http_client(0,5,0)-      fullResp <- H.responseBody response C.$$+- CB.sinkLbs+      fullResp <- C.runConduit $ (H.responseBody response) .| CB.sinkLbs       let res' = fmap (const ()) response       let statusexc = H.HttpExceptionRequest req $ H.StatusCodeException res' (L.toStrict fullResp) #else@@ -203,7 +190,7 @@        val <- E.try $ asJsonHelper response       case val :: Either E.SomeException FacebookException of-        Right fbexc -> E.throw fbexc+        Right fbexc -> E.throwIO fbexc         Left _ -> do           case AT.parse wwwAuthenticateParser <$>                lookup "WWW-Authenticate" headers of@@ -226,7 +213,7 @@  -- | Send a @HEAD@ request just to see if the resposne status -- code is 2XX (returns @True@) or not (returns @False@).-httpCheck :: (MonadBaseControl IO m, R.MonadResource m) =>+httpCheck :: (R.MonadResource m, R.MonadUnliftIO m) =>              H.Request           -> FacebookT anyAuth m Bool 

@@ -1,13 +1,14 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+ module Facebook.FQL-    ( fqlQuery-    , FQLTime(..)-    , FQLList(..)-    , FQLObject(..)-    ) where+  ( fqlQuery+  , FQLTime(..)+  , FQLList(..)+  , FQLObject(..)+  ) where -import Control.Applicative((<$>))-import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Applicative ((<$>)) import Data.Monoid (mempty) import Data.Text (Text) import Data.Time (UTCTime)@@ -23,31 +24,29 @@ import Facebook.Graph import Facebook.Pager - -- | Query the Facebook Graph using FQL.-fqlQuery :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>-            Text                        -- ^ FQL Query-         -> Maybe (AccessToken anyKind) -- ^ Optional access token-         -> FacebookT anyAuth m (Pager a)+fqlQuery+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)+  => Text -- ^ FQL Query+  -> Maybe (AccessToken anyKind) -- ^ Optional access token+  -> FacebookT anyAuth m (Pager a) fqlQuery fql mtoken =-  runResourceInFb $ do-    let query = ["q" #= fql]-    asJson =<< fbhttp =<< fbreq "/fql" mtoken query-+  runResourceInFb $+  do let query = ["q" #= fql]+     asJson =<< fbhttp =<< fbreq "/fql" mtoken query  -- | @newtype@ wrapper around 'UTCTime' that is able to parse -- FQL's time representation as seconds since the Unix epoch.-newtype FQLTime = FQLTime { unFQLTime :: UTCTime }-  deriving (Eq, Ord, Show)+newtype FQLTime = FQLTime+  { unFQLTime :: UTCTime+  } deriving (Eq, Ord, Show)  instance A.FromJSON FQLTime where-  parseJSON = fmap ( FQLTime-                   . posixSecondsToUTCTime-                   . fromInteger)-            . A.parseJSON--{-# DEPRECATED FQLTime "Deprecated since fb 0.14.7, please use FbUTCTime instead." #-}+  parseJSON = fmap (FQLTime . posixSecondsToUTCTime . fromInteger) . A.parseJSON +{-# DEPRECATED+FQLTime "Deprecated since fb 0.14.7, please use FbUTCTime instead."+ #-}  -- | @newtype@ wrapper around lists that works around FQL's -- strange lists.@@ -61,13 +60,14 @@ -- On the other hand, not all FQL arrays are represented in this -- bogus manner.  Also, some so-called arrays by FQL's -- documentation are actually objects, see 'FQLObject'.-newtype FQLList a = FQLList { unFQLList :: [a] }-  deriving (Eq, Ord, Show)+newtype FQLList a = FQLList+  { unFQLList :: [a]+  } deriving (Eq, Ord, Show) -instance A.FromJSON a => A.FromJSON (FQLList a) where+instance A.FromJSON a =>+         A.FromJSON (FQLList a) where   parseJSON (A.Object o) = FQLList <$> mapM A.parseJSON (HMS.elems o)-  parseJSON v            = FQLList <$> A.parseJSON v-+  parseJSON v = FQLList <$> A.parseJSON v  -- | @newtype@ wrapper around any object that works around FQL's -- strange objects.@@ -77,9 +77,12 @@ -- empty lists @[]@ instead of a proper empty object @{}@.  Also -- note that FQL's documentation says that @app_data@ is an -- array, which it clear is not.  See also 'FQLList'.-newtype FQLObject a = FQLObject { unFQLObject :: a }-  deriving (Eq, Ord, Show)+newtype FQLObject a = FQLObject+  { unFQLObject :: a+  } deriving (Eq, Ord, Show) -instance A.FromJSON a => A.FromJSON (FQLObject a) where-  parseJSON (A.Array a) | a == mempty = FQLObject <$> A.parseJSON (A.Object mempty)-  parseJSON v                         = FQLObject <$> A.parseJSON v+instance A.FromJSON a =>+         A.FromJSON (FQLObject a) where+  parseJSON (A.Array a)+    | a == mempty = FQLObject <$> A.parseJSON (A.Object mempty)+  parseJSON v = FQLObject <$> A.parseJSON v

@@ -1,5 +1,7 @@-{-# LANGUAGE ConstraintKinds, CPP, DeriveDataTypeable,-  FlexibleContexts, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}  module Facebook.Graph   ( getObject@@ -17,7 +19,6 @@ import Control.Applicative #endif import Control.Monad (mzero)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.ByteString.Char8 (ByteString) import Data.Int (Int8, Int16, Int32, Int64) import Data.List (intersperse)@@ -52,7 +53,7 @@  -- | Make a raw @GET@ request to Facebook's Graph API. getObject-  :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)   => Text -- ^ Path (should begin with a slash @\/@)   -> [Argument] -- ^ Arguments to be passed to Facebook   -> Maybe (AccessToken anyKind) -- ^ Optional access token@@ -62,7 +63,7 @@  -- | Make a raw @POST@ request to Facebook's Graph API. postObject-  :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)   => Text -- ^ Path (should begin with a slash @\/@)   -> [Argument] -- ^ Arguments to be passed to Facebook   -> AccessToken anyKind -- ^ Access token@@ -71,7 +72,7 @@  -- | Make a raw @DELETE@ request to Facebook's Graph API. deleteObject-  :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)   => Text -- ^ Path (should begin with a slash @\/@)   -> [Argument] -- ^ Arguments to be passed to Facebook   -> AccessToken anyKind -- ^ Access token@@ -80,7 +81,7 @@  -- | Helper function used by 'postObject' and 'deleteObject'. methodObject-  :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)   => HT.Method   -> Text -- ^ Path (should begin with a slash @\/@)   -> [Argument] -- ^ Arguments to be passed to Facebook@@ -98,7 +99,7 @@ -- | Make a raw @GET@ request to the /search endpoint of Facebook’s -- Graph API.  Returns a raw JSON 'A.Value'. searchObjects-  :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, A.FromJSON a)   => Text -- ^ A Facebook object type to search for   -> Text -- ^ The keyword to search for   -> [Argument] -- ^ Additional arguments to pass

@@ -1,31 +1,32 @@-{-# LANGUAGE CPP,-             DeriveDataTypeable,-             FlexibleContexts,-             FlexibleInstances,-             GeneralizedNewtypeDeriving,-             MultiParamTypeClasses,-             StandaloneDeriving,-             TypeFamilies,-             UndecidableInstances #-}-module Facebook.Monad-    ( FacebookT-    , Auth-    , NoAuth-    , FbTier(..)-    , runFacebookT-    , runNoAuthFacebookT-    , beta_runFacebookT-    , beta_runNoAuthFacebookT-    , getCreds-    , getManager-    , getTier-    , withTier-    , runResourceInFb-    , mapFacebookT+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-} -      -- * Re-export-    , lift-    ) where+module Facebook.Monad+  ( FacebookT+  , Auth+  , NoAuth+  , FbTier(..)+  , runFacebookT+  , runNoAuthFacebookT+  , beta_runFacebookT+  , beta_runNoAuthFacebookT+  , getCreds+  , getManager+  , getTier+  , withTier+  , runResourceInFb+  , mapFacebookT+   -- * Re-export+  , lift+  ) where  import Control.Applicative (Applicative, Alternative) import Control.Monad (MonadPlus, liftM)@@ -34,12 +35,7 @@ import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger (MonadLogger(..)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.Control ( MonadTransControl(..), MonadBaseControl(..)-                                   , ComposeSt, defaultLiftBaseWith-                                   , defaultRestoreM )-#if MIN_VERSION_monad_control(1,0,0)-import Control.Monad.Trans.Control (defaultLiftWith, defaultRestoreT)-#endif+import UnliftIO import Control.Monad.Trans.Reader (ReaderT(..), ask, mapReaderT) import Data.Typeable (Typeable) import qualified Control.Monad.Trans.Resource as R@@ -48,122 +44,129 @@  import Facebook.Types - -- | @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 }-    deriving ( Functor, Applicative, Alternative, Monad, MonadFix-             , MonadPlus, MonadIO, MonadTrans, R.MonadThrow )--deriving instance (R.MonadResource m, MonadBase IO m) => R.MonadResource (FacebookT auth m)+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) -instance MonadBase b m => MonadBase b (FacebookT auth m) where-    liftBase = lift . liftBase+deriving instance+         (R.MonadResource m, MonadBase IO m) =>+         R.MonadResource (FacebookT auth m) -instance MonadTransControl (FacebookT auth) where-#if MIN_VERSION_monad_control(1,0,0)-    type StT (FacebookT auth) a = StT (ReaderT FbData) a-    liftWith = defaultLiftWith F unF-    restoreT = defaultRestoreT F-#else-    newtype StT (FacebookT auth) a = FbStT { unFbStT :: StT (ReaderT FbData) a }-    liftWith f = F $ liftWith (\run -> f (liftM FbStT . run . unF))-    restoreT   = F . restoreT . liftM unFbStT-#endif+instance MonadBase b m =>+         MonadBase b (FacebookT auth m) where+  liftBase = lift . liftBase -instance MonadBaseControl b m => MonadBaseControl b (FacebookT auth m) where-#if MIN_VERSION_monad_control(1,0,0)-    type StM (FacebookT auth m) a = ComposeSt (FacebookT auth) m a-    liftBaseWith = defaultLiftBaseWith-    restoreM     = defaultRestoreM-#else-    newtype StM (FacebookT auth m) a = StMT {unStMT :: ComposeSt (FacebookT auth) m a}-    liftBaseWith = defaultLiftBaseWith StMT-    restoreM     = defaultRestoreM   unStMT-#endif+-- askUnliftIO = ReaderT $ \r ->+--                 withUnliftIO $ \u ->+-- return (UnliftIO (unliftIO u . flip runReaderT r))+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))))))  -- | Since @fb-0.14.8@.-instance MonadLogger m => MonadLogger (FacebookT auth m) where-    monadLoggerLog loc src lvl msg = lift (monadLoggerLog loc src lvl msg)-+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 -- 'Credentials' and thus have access to the whole API.-data Auth deriving (Typeable)+data Auth+  deriving (Typeable)  -- | Phantom type stating that you have /not/ provided your -- 'Credentials'.  This means that you'll be limited about which -- APIs you'll be able use.-data NoAuth deriving (Typeable)+data NoAuth+  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 :: Credentials -- ^ Can be 'undefined'!+  , fbdManager :: !H.Manager+  , fbdTier :: !FbTier+  } deriving (Typeable)  -- | Which Facebook tier should be used (see -- <https://developers.facebook.com/support/beta-tier/>).-data FbTier = Production | Beta deriving (Eq, Ord, Show, Read, Enum, Typeable)-+data FbTier+  = Production+  | Beta+  deriving (Eq, Ord, Show, Read, Enum, Typeable)  -- | Run a computation in the 'FacebookT' monad transformer with -- your credentials.-runFacebookT :: Credentials         -- ^ Your app's credentials.-             -> H.Manager           -- ^ Connection manager (see 'H.withManager').-             -> FacebookT Auth m a-             -> m a+runFacebookT+  :: 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)+  runReaderT act (FbData creds manager Production)  -- | 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)+  let creds = error "runNoAuthFacebookT: never here, serious bug"+  in runReaderT act (FbData creds manager Production)  -- | 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)+  runReaderT act (FbData creds manager Beta)  -- | 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)-+  let creds = error "beta_runNoAuthFacebookT: never here, serious bug"+  in runReaderT act (FbData creds manager Beta)  -- | Get the user's credentials.-getCreds :: Monad m => FacebookT Auth m Credentials+getCreds+  :: Monad m+  => FacebookT Auth m Credentials getCreds = fbdCreds `liftM` F ask  -- | 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, MonadBaseControl IO 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'. mapFacebookT :: (m a -> n b) -> FacebookT anyAuth m a -> FacebookT anyAuth n b

@@ -1,11 +1,13 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+ module Facebook.Object.Action-   ( createAction-   , Action(..)-   ) where+  ( createAction+  , Action(..)+  ) where  import Control.Arrow (first)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.Function (on) import Data.String (IsString(..)) import Data.Text (Text)@@ -16,7 +18,6 @@ import Facebook.Monad import Facebook.Graph - -- | Creates an Open Graph action on the user's timeline. Returns -- the 'Id' of the newly created action.  For example: --@@ -25,25 +26,27 @@ -- >              [ "recipe" #= "http://example.com/cookie.html" -- >              , "when"   #= now ] -- >              token-createAction :: (R.MonadResource m, MonadBaseControl IO m)  =>-                Action     -- ^ Action kind to be created.-             -> [Argument] -- ^ Arguments of the action.-             -> Maybe AppAccessToken-                -- ^ Optional app access token (optional with-                -- respect to this library, since you can't make-                -- this mandatory by changing the settings of-                -- your action on Facebook).-             -> UserAccessToken -- ^ Required user access token.-             -> FacebookT Auth m Id+createAction+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+  => Action -- ^ Action kind to be created.+  -> [Argument] -- ^ Arguments of the action.+  -> Maybe AppAccessToken+     -- ^ Optional app access token (optional with+     -- respect to this library, since you can't make+     -- this mandatory by changing the settings of+     -- your action on Facebook).+  -> UserAccessToken -- ^ Required user access token.+  -> FacebookT Auth m Id createAction (Action action) query mapptoken usertoken = do   creds <- getCreds-  let post :: (R.MonadResource m, MonadBaseControl IO m)  => Text -> AccessToken anyKind -> FacebookT Auth m Id+  let post+        :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+        => Text -> AccessToken anyKind -> FacebookT Auth m Id       post prepath = postObject (prepath <> appName creds <> ":" <> action) query   case mapptoken of-    Nothing       -> post "/me/" usertoken+    Nothing -> post "/me/" usertoken     Just apptoken -> post ("/" <> idCode (accessTokenUserId usertoken) <> "/") apptoken - -- | An action of your app.  Please refer to Facebook's -- documentation at -- <https://developers.facebook.com/docs/opengraph/keyconcepts/#actions-objects>@@ -58,27 +61,29 @@ -- > foo token = do -- >   ... -- >   createAction "cook" [...] token-newtype Action = Action { unAction :: Text }+newtype Action = Action+  { unAction :: Text+  }  instance Show Action where-    show = show . unAction+  show = show . unAction  -- | Since 0.7.1 instance Eq Action where-    (==) = (==) `on` unAction-    (/=) = (/=) `on` unAction+  (==) = (==) `on` unAction+  (/=) = (/=) `on` unAction  -- | Since 0.7.1 instance Ord Action where-    compare = compare `on` unAction-    (<=) = (<=) `on` unAction-    (<)  = (<)  `on` unAction-    (>=) = (>=) `on` unAction-    (>)  = (>)  `on` unAction+  compare = compare `on` unAction+  (<=) = (<=) `on` unAction+  (<) = (<) `on` unAction+  (>=) = (>=) `on` unAction+  (>) = (>) `on` unAction  -- | Since 0.7.1 instance Read Action where-    readsPrec = (fmap (first Action) .) . readsPrec+  readsPrec = (fmap (first Action) .) . readsPrec  instance IsString Action where-    fromString = Action . fromString+  fromString = Action . fromString

@@ -1,5 +1,7 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts,-  OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}  module Facebook.Object.Checkin   ( Checkin(..)@@ -11,7 +13,6 @@ import Control.Applicative #endif import Control.Monad (mzero)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson ((.:), (.:?)) import Data.Text (Text) import Data.Time (UTCTime)@@ -62,7 +63,7 @@ -- optional, but when provided more information can be returned -- back by Facebook. getCheckin-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => Id -- ^ Checkin ID.   -> [Argument] -- ^ Arguments to be passed to Facebook.   -> Maybe UserAccessToken -- ^ Optional user access token.@@ -72,7 +73,7 @@ -- | Creates a 'check-in' and returns its ID. Place and -- coordinates are both required by Facebook. createCheckin-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => Id -- ^ Place ID.   -> GeoCoordinates -- ^ Coordinates.   -> [Argument] -- ^ Other arguments of the action.

@@ -1,5 +1,7 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts,-  OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}  module Facebook.Object.FriendList   ( FriendList(..)@@ -11,7 +13,6 @@ import Control.Applicative #endif import Control.Monad (mzero)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson ((.:)) import Data.Text (Text) import Data.Typeable (Typeable)@@ -75,7 +76,7 @@ -- close_friends, acquaintances, restricted, user_created, education, work, current_city, family -- | Get the friend lists of the given user. getUserFriendLists-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => UserId -- ^ User ID or @\"me\"@.   -> [Argument] -- ^ Arguments to be passed to Facebook.   -> UserAccessToken -- ^ User access token.@@ -85,7 +86,7 @@  -- | Get the members of a friend list. getFriendListMembers-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => Id -- ^ List ID.   -> [Argument] -- ^ Arguments to be passed to Facebook.   -> UserAccessToken -- ^ User access token.

@@ -1,5 +1,6 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts,-  OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}  module Facebook.Object.Order   ( Order(..)@@ -8,11 +9,8 @@   , OrderApplication(..)   , getOrder   ) where-#if __GLASGOW_HASKELL__ <= 784-import Control.Applicative-#endif+ import Control.Monad (mzero)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.Text (Text) import Data.Aeson ((.:), (.:?)) import Data.Typeable (Typeable)@@ -83,7 +81,7 @@ -- | Get an 'Order' using its 'OrderId'.  The user access token -- is mandatory. getOrder-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => OrderId -- ^ Order ID.   -> UserAccessToken -- ^ User access token.   -> FacebookT anyAuth m Order

@@ -1,5 +1,6 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts,-  OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}  module Facebook.Object.Page   ( Page(..)@@ -7,11 +8,8 @@   , getPage_   , searchPages   ) where-#if __GLASGOW_HASKELL__ <= 784-import Control.Applicative-#endif+ import Control.Monad (mzero)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson ((.:), (.:?)) import qualified Control.Monad.Trans.Resource as R import qualified Data.Aeson as A@@ -60,7 +58,7 @@  -- | Get a page using its ID. The user access token is optional. getPage-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => Id -- ^ Page ID   -> [Argument] -- ^ Arguments to be passed to Facebook   -> Maybe UserAccessToken -- ^ Optional user access token@@ -69,7 +67,7 @@  -- | Get a page using its ID. The user access token is optional. getPage_-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => Id -- ^ Page ID   -> [Argument] -- ^ Arguments to be passed to Facebook   -> Maybe AppAccessToken -- ^ Optional user access token@@ -78,7 +76,7 @@  -- | Search pages by keyword. The user access token is optional. searchPages-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => Text -- ^ Keyword to search for   -> [Argument] -- ^ Arguments to pass to Facebook   -> Maybe UserAccessToken -- ^ Optional user access token

@@ -1,5 +1,6 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts,-  OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}  module Facebook.Object.User   ( User(..)@@ -10,11 +11,8 @@   , Friend(..)   , getUserFriends   ) where-#if __GLASGOW_HASKELL__ <= 784-import Control.Applicative-#endif+ import Control.Monad (mzero)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson ((.:), (.:?)) import Data.Text (Text) import Data.Typeable (Typeable)@@ -85,7 +83,7 @@ -- case you must provide an user access token and information -- about the token's owner is given. getUser-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => UserId -- ^ User ID or @\"me\"@.   -> [Argument] -- ^ Arguments to be passed to Facebook.   -> Maybe UserAccessToken -- ^ Optional user access token.@@ -94,7 +92,7 @@  -- | Search users by keyword. searchUsers-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => Text   -> [Argument]   -> Maybe UserAccessToken@@ -103,7 +101,7 @@  -- | Get a list of check-ins made by a given user. getUserCheckins-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => UserId -- ^ User ID or @\"me\"@.   -> [Argument] -- ^ Arguments to be passed to Facebook.   -> UserAccessToken -- ^ User access token.@@ -123,7 +121,7 @@  -- | Get the list of friends of the given user. getUserFriends-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => UserId -- ^ User ID or @\"me\"@.   -> [Argument] -- ^ Arguments to be passed to Facebook.   -> UserAccessToken -- ^ User access token.

@@ -1,5 +1,6 @@-{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, FlexibleContexts,-  OverloadedStrings#-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}  module Facebook.Pager   ( Pager(..)@@ -8,13 +9,9 @@   , fetchAllNextPages   , fetchAllPreviousPages   ) where-#if __GLASGOW_HASKELL__ <= 784-import Control.Applicative-#endif+ import Control.Monad (mzero) import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Monad.Trans.Resource (MonadResourceBase) import Data.Typeable (Typeable)  import qualified Control.Monad.Trans.Resource as R@@ -65,7 +62,7 @@ -- 'Nothing' whenever the current @Pager@ does not have a -- 'pagerNext'. fetchNextPage-  :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)+  :: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)   => Pager a -> FacebookT anyAuth m (Maybe (Pager a)) fetchNextPage = fetchHelper pagerNext @@ -73,13 +70,13 @@ -- 'Nothing' whenever the current @Pager@ does not have a -- 'pagerPrevious'. fetchPreviousPage-  :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)+  :: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)   => Pager a -> FacebookT anyAuth m (Maybe (Pager a)) fetchPreviousPage = fetchHelper pagerPrevious  -- | (Internal) See 'fetchNextPage' and 'fetchPreviousPage'. fetchHelper-  :: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)+  :: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)   => (Pager a -> Maybe String)   -> Pager a   -> FacebookT anyAuth m (Maybe (Pager a))@@ -87,11 +84,7 @@   case pagerRef pager of     Nothing -> return Nothing     Just url -> do-#if MIN_VERSION_http_client(0,4,30)       req <- liftIO (H.parseRequest url)-#else-      req <- liftIO (H.parseUrl url)-#endif       Just <$>         (asJson =<<          fbhttp@@ -104,8 +97,8 @@ -- this page as well.  Previous pages will not be considered. -- Next pages will be fetched on-demand. fetchAllNextPages-  :: (Monad m, MonadResourceBase n, A.FromJSON a)-  => Pager a -> FacebookT anyAuth m (C.Source n a)+  :: (Monad m, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)+  => Pager a -> FacebookT anyAuth m (C.ConduitT () a n ()) fetchAllNextPages = fetchAllHelper pagerNext  -- | Tries to fetch all previous pages and returns a 'C.Source'@@ -113,24 +106,22 @@ -- from this page as well.  Next pages will not be -- considered.  Previous pages will be fetched on-demand. fetchAllPreviousPages-  :: (Monad m, MonadResourceBase n, A.FromJSON a)-  => Pager a -> FacebookT anyAuth m (C.Source n a)+  :: (Monad m, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)+  => Pager a -> FacebookT anyAuth m (C.ConduitT () a n ()) fetchAllPreviousPages = fetchAllHelper pagerPrevious  -- | (Internal) See 'fetchAllNextPages' and 'fetchAllPreviousPages'. fetchAllHelper-  :: (Monad m, MonadResourceBase n, A.FromJSON a)-  => (Pager a -> Maybe String) -> Pager a -> FacebookT anyAuth m (C.Source n a)+  :: (Monad m, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)+  => (Pager a -> Maybe String)+  -> Pager a+  -> FacebookT anyAuth m (C.ConduitT () a n ()) fetchAllHelper pagerRef pager = do   manager <- getManager   let go (x:xs) mnext = C.yield x >> go xs mnext       go [] Nothing = return ()       go [] (Just next) = do-#if MIN_VERSION_http_client(0,4,30)         req <- liftIO (H.parseRequest next)-#else-        req <- liftIO (H.parseUrl next)-#endif         let get =               fbhttpHelper                 manager

@@ -1,20 +1,21 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+ module Facebook.RealTime-    ( RealTimeUpdateObject(..)-    , RealTimeUpdateField-    , RealTimeUpdateUrl-    , RealTimeUpdateToken-    , modifySubscription-    , RealTimeUpdateSubscription(..)-    , listSubscriptions-    , verifyRealTimeUpdateNotifications-    , getRealTimeUpdateNotifications-    , RealTimeUpdateNotification(..)-    , RealTimeUpdateNotificationUserEntry(..)-    ) where+  ( RealTimeUpdateObject(..)+  , RealTimeUpdateField+  , RealTimeUpdateUrl+  , RealTimeUpdateToken+  , modifySubscription+  , RealTimeUpdateSubscription(..)+  , listSubscriptions+  , verifyRealTimeUpdateNotifications+  , getRealTimeUpdateNotifications+  , RealTimeUpdateNotification(..)+  , RealTimeUpdateNotificationUserEntry(..)+  ) where  import Control.Applicative ((<$>), (<*>))-import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad (liftM, mzero, void) import Crypto.Hash.CryptoAPI (SHA1) import Data.ByteString.Char8 (ByteString)@@ -41,122 +42,118 @@ import Facebook.Graph import Facebook.Pager - -- | The type of objects that a real-time update refers to.-data RealTimeUpdateObject =-    UserRTUO+data RealTimeUpdateObject+  = UserRTUO   | PermissionsRTUO   | PageRTUO   | ErrorsRTUO   | OtherRTUO Text-    deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show, Typeable)  rtuoToBS :: RealTimeUpdateObject -> ByteString-rtuoToBS (UserRTUO)        = "user"+rtuoToBS (UserRTUO) = "user" rtuoToBS (PermissionsRTUO) = "permissions"-rtuoToBS (PageRTUO)        = "page"-rtuoToBS (ErrorsRTUO)      = "errors"+rtuoToBS (PageRTUO) = "page"+rtuoToBS (ErrorsRTUO) = "errors" rtuoToBS (OtherRTUO other) = TE.encodeUtf8 other  instance A.FromJSON RealTimeUpdateObject where-  parseJSON (A.String "user")        = return UserRTUO+  parseJSON (A.String "user") = return UserRTUO   parseJSON (A.String "permissions") = return PermissionsRTUO-  parseJSON (A.String "page")        = return PageRTUO-  parseJSON (A.String "errors")      = return ErrorsRTUO-  parseJSON (A.String other)         = return (OtherRTUO other)+  parseJSON (A.String "page") = return PageRTUO+  parseJSON (A.String "errors") = return ErrorsRTUO+  parseJSON (A.String other) = return (OtherRTUO other)   parseJSON _ = mzero  instance A.ToJSON RealTimeUpdateObject where   toJSON = A.String . TE.decodeUtf8 . rtuoToBS - -- | A field of a 'RealTimeUpdateObject' that you would like to -- receive notifications when changed. type RealTimeUpdateField = ByteString - -- | The URL on your server that will receive the real-time -- updates.  Please refer to Facebook's documentation in order to -- see what this URL needs to implement. type RealTimeUpdateUrl = Text - -- | A token that is sent back by Facebook's servers to your -- server in order to verify that you really were trying to -- modify your subscription. type RealTimeUpdateToken = ByteString - -- | Add or modify a subscription for real-time updates.  If -- there were no previous subscriptions for the given -- 'RealTimeUpdateObject', then a new subscription is created. -- 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, MonadBaseControl IO m) =>-                      RealTimeUpdateObject-                      -- ^ Type of objects whose subscription you-                      -- and to add or modify.-                   -> [RealTimeUpdateField]-                      -- ^ Fields that you are interested in-                      -- receiving updates.-                   -> RealTimeUpdateUrl-                      -- ^ Your callback URL.-                   -> RealTimeUpdateToken-                      -- ^ A verification token.-                   -> AppAccessToken-                      -- ^ Access token for your app.-                   -> FacebookT Auth m ()+modifySubscription+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)+  => RealTimeUpdateObject+     -- ^ Type of objects whose subscription you+     -- and to add or modify.+  -> [RealTimeUpdateField]+     -- ^ Fields that you are interested in+     -- receiving updates.+  -> RealTimeUpdateUrl+     -- ^ Your callback URL.+  -> RealTimeUpdateToken+     -- ^ A verification token.+  -> AppAccessToken+     -- ^ Access token for your app.+  -> FacebookT Auth m () modifySubscription object fields callbackUrl verifyToken apptoken = do   path <- getSubscriptionsPath-  let args = [ "object"       #= rtuoToBS object-             , "fields"       #= fields-             , "callback_url" #= callbackUrl-             , "verify_token" #= verifyToken-             ]-  runResourceInFb $ do-    req <- fbreq path (Just apptoken) args-    void $ fbhttp req { H.method = HT.methodPost }+  let args =+        [ "object" #= rtuoToBS object+        , "fields" #= fields+        , "callback_url" #= callbackUrl+        , "verify_token" #= verifyToken+        ]+  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+  => 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+data RealTimeUpdateSubscription = RealTimeUpdateSubscription+  { rtusObject :: RealTimeUpdateObject   , rtusCallbackUrl :: RealTimeUpdateUrl-  , rtusFields      :: [RealTimeUpdateField]-  , rtusActive      :: Bool+  , rtusFields :: [RealTimeUpdateField]+  , rtusActive :: Bool   } deriving (Eq, Ord, Show, Typeable)  instance A.FromJSON RealTimeUpdateSubscription where   parseJSON (A.Object v) =-    RealTimeUpdateSubscription-      <$> v A..: "object"-      <*> v A..: "callback_url"-      <*> fmap (map encodeUtf8) (v A..: "fields")-      <*> v A..: "active"+    RealTimeUpdateSubscription <$> v A..: "object" <*> v A..: "callback_url" <*>+    fmap (map encodeUtf8) (v A..: "fields") <*>+    v A..: "active"   parseJSON _ = mzero - -- | List current real-time update subscriptions.-listSubscriptions ::-  (R.MonadResource m, MonadBaseControl IO 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 $ src C.$$ CL.consume-+  lift $ C.runConduit $ src C..| CL.consume  -- | Verifies the input's authenticity (i.e. it comes from -- Facebook) and integrity by calculating its HMAC-SHA1 (using@@ -165,9 +162,9 @@ -- 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 =>-     ByteString+verifyRealTimeUpdateNotifications+  :: Monad m+  => ByteString      -- ^ @X-Hub-Signature@ HTTP header's value.   -> L.ByteString      -- ^ Request body with JSON-encoded notifications.@@ -178,24 +175,24 @@       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-+  return $!+    if sig `Crypto.constTimeEq` expected+      then Just body+      else Nothing  -- | Same as 'verifyRealTimeUpdateNotifications' but also parses -- the response as JSON.  Returns @Nothing@ if either the -- 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) =>-     ByteString+getRealTimeUpdateNotifications+  :: (Monad m, A.FromJSON a)+  => 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@@ -210,33 +207,27 @@ -- the value of 'rtunObject'. -- -- We recommend using 'getRealTimeUpdateNotifications'.-data RealTimeUpdateNotification a =-  RealTimeUpdateNotification {-    rtunObject  :: RealTimeUpdateObject+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"+    RealTimeUpdateNotification <$> v A..: "object" <*> v A..: "entry"   parseJSON _ = mzero - -- | A notification for the 'UserRTUO' object.-data RealTimeUpdateNotificationUserEntry =-  RealTimeUpdateNotificationUserEntry {-    rtuneUserId        :: Id+data RealTimeUpdateNotificationUserEntry = RealTimeUpdateNotificationUserEntry+  { rtuneUserId :: Id   , rtuneChangedFields :: [RealTimeUpdateField]-  , rtuneTime          :: Integer+  , rtuneTime :: Integer   } deriving (Eq, Ord, Show, Typeable)  instance A.FromJSON RealTimeUpdateNotificationUserEntry where   parseJSON (A.Object v) =-    RealTimeUpdateNotificationUserEntry-      <$> v A..: "uid"-      <*> fmap (map encodeUtf8) (v A..: "changed_fields")-      <*> v A..: "time"-+    RealTimeUpdateNotificationUserEntry <$> v A..: "uid" <*>+    fmap (map encodeUtf8) (v A..: "changed_fields") <*>+    v A..: "time"   parseJSON _ = mzero

@@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}  module Facebook.TestUsers   ( TestUser(..)@@ -14,7 +16,6 @@  import Control.Applicative ((<$>), (<*>)) import Control.Monad (unless, mzero)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.ByteString.Lazy (fromStrict) import Data.Default import Data.Text@@ -24,7 +25,7 @@ import Data.Aeson import Data.Aeson.Types -import qualified Control.Exception.Lifted as E+import qualified UnliftIO.Exception as E import qualified Control.Monad.Trans.Resource as R import qualified Data.Aeson as A import qualified Data.ByteString.Char8 as B@@ -93,7 +94,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, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => CreateTestUser -- ^ How the test user should be      -- created.   -> AppAccessToken -- ^ Access token for your app.@@ -105,7 +106,7 @@  -- | Get a list of test users. getTestUsers-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => AppAccessToken -- ^ Access token for your app.   -> FacebookT Auth m (Pager TestUser) getTestUsers token = do@@ -113,7 +114,7 @@   getObject ("/" <> appId creds <> "/accounts/test-users") [] (Just token)  disassociateTestuser-  :: (MonadBaseControl IO m, R.MonadResource m)+  :: (R.MonadUnliftIO m, R.MonadThrow m, R.MonadResource m)   => TestUser -> AppAccessToken -> FacebookT Auth m Bool disassociateTestuser testUser _token = do   creds <- getCreds@@ -124,7 +125,7 @@  -- | Remove an existing test user. removeTestUser-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => TestUser -- ^ The TestUser to be removed.   -> AppAccessToken -- ^ Access token for your app (ignored since fb 0.14.7).   -> FacebookT Auth m Bool@@ -143,14 +144,14 @@ -- user B as query parameter. The first call creates a friend request -- and the second call accepts the friend request. makeFriendConn-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => TestUser -> TestUser -> FacebookT Auth m () makeFriendConn (TestUser {tuAccessToken = Nothing}) _ =-  E.throw $+  E.throwIO $   FbLibraryException     "The test user passed on the first argument doesn't have a token. Both users must have a token." makeFriendConn _ (TestUser {tuAccessToken = Nothing}) =-  E.throw $+  E.throwIO $   FbLibraryException     "The test user passed on the second argument doesn't have a token. Both users must have a token." makeFriendConn (TestUser {tuId = id1@@ -163,8 +164,8 @@           Nothing   r1 <- friendReq id1 id2 token1   r2 <- friendReq id2 id1 token2-  unless r1 $ E.throw $ FbLibraryException "Couldn't make friend request."-  unless r2 $ E.throw $ FbLibraryException "Couldn't accept friend request."+  unless r1 $ E.throwIO $ FbLibraryException "Couldn't make friend request."+  unless r2 $ E.throwIO $ FbLibraryException "Couldn't accept friend request."   return ()  -- | Create an 'UserAccessToken' from a 'TestUser'.  It's incomplete@@ -179,7 +180,7 @@ -- as a JSON, it tries to parse either as "true" or "false". -- Used only by the Test User API bindings. getObjectBool-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)   => Text      -- ^ Path (should begin with a slash @\/@).   -> [Argument]

@@ -1,4 +1,9 @@-{-# LANGUAGE CPP, DeriveDataTypeable, GADTs, StandaloneDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving#-}+{-# LANGUAGE StandaloneDeriving#-}+{-# LANGUAGE GADTs#-}+{-# LANGUAGE DeriveDataTypeable#-}+{-# LANGUAGE CPP#-}  module Facebook.Types   ( Credentials(..)

@@ -10,7 +10,6 @@ import Control.Monad (mzero) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Control (MonadBaseControl) import Data.Function (on) import Data.Int (Int8, Int16, Int32, Int64) import Data.Maybe (isJust, isNothing)@@ -22,7 +21,7 @@ import System.IO.Error (isDoesNotExistError) import Data.List ((\\)) import Data.Monoid ((<>))-import qualified Control.Exception.Lifted as E+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@@ -54,7 +53,7 @@         mapM getEnv ["APP_NAME", "APP_ID", "APP_SECRET"]       return $ FB.Credentials (T.pack appName) (T.pack appId) (T.pack appSecret)     showHelp exc-      | not (isDoesNotExistError exc) = E.throw exc+      | not (isDoesNotExistError exc) = E.throwIO exc     showHelp _ = do       putStrLn $         unlines@@ -94,28 +93,27 @@ invalidAppAccessToken = FB.AppAccessToken "invalid"  main :: IO ()-main =-  H.withManager $-  \manager ->-     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)-             -- ...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)-             -- Tests that don't depend on which tier is chosen.-             libraryTests manager+main = do+  manager <- H.newManager H.tlsManagerSettings+  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)+            -- ...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)+            -- Tests that don't depend on which tier is chosen.+            libraryTests manager  facebookTests   :: String@@ -252,7 +250,7 @@                  backAndForthWorks =<<                    FB.getObject                      "/5281959998_10150628170209999/comments"-                     []+                     [("filter", "stream")]                      (Just token)        it "seems to work on a private list of app insights" $          do runAuth $@@ -520,7 +518,7 @@ -- | Perform an action with a new test user. Remove the new test user -- after the action is performed. withTestUser-  :: (R.MonadResource m, MonadBaseControl IO m)+  :: (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