fb 0.6 → 0.6.0.1

raw patch · 3 files changed

+27/−21 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• fb.cabal +1/−1
• src/Facebook/Auth.hs +16/−20
• src/Facebook/Base.hs +10/−0

@@ -1,5 +1,5 @@ name:              fb-version:           0.6+version:           0.6.0.1 license:           BSD3 license-file:      LICENSE author:            Felipe Lessa

@@ -11,6 +11,7 @@     ) where  import Control.Applicative+import Control.Monad (join) import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Aeson ((.:)) import Data.Aeson.Types (parseEither)@@ -21,6 +22,8 @@  import qualified Control.Exception.Lifted as E import qualified Data.Attoparsec.Char8 as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8 import qualified Data.Conduit as C import qualified Data.Conduit.Attoparsec as C import qualified Data.List as L@@ -91,9 +94,7 @@       creds <- getCreds       let req = fbreq "/oauth/access_token" Nothing $                 tsq creds [code, ("redirect_uri", TE.encodeUtf8 redirectUrl)]-      response <- fbhttp req-      preToken <- lift $ H.responseBody response C.$$-                         C.sinkParser (userAccessTokenParser now)+      preToken <- fmap (userAccessTokenParser now) . asBS =<< fbhttp req        -- Get user's ID throught Facebook's graph.       userInfo <- asJson =<< fbhttp (fbreq "/me" (Just preToken) [("fields", "id")])@@ -117,16 +118,16 @@ -- Facebook as a query string.  Returns an user access token with -- a broken 'UserId'. userAccessTokenParser :: UTCTime -- ^ 'getCurrentTime'-                      -> A.Parser UserAccessToken-userAccessTokenParser now =-    UserAccessToken userId-      <$  A.string "access_token="-      <*> A.takeWhile (/= '?')-      <*  A.string "&expires="-      <*> (toExpire <$> A.decimal)-      <*  A.endOfInput-    where toExpire i = addUTCTime (fromIntegral (i :: Int)) now-          userId = error "userAccessTokenParser: never here"+                      -> B.ByteString+                      -> UserAccessToken+userAccessTokenParser now bs =+    let q = HT.parseQuery bs; lookup' a = join (lookup a q)+    in case (,) <$> lookup' "access_token" <*> lookup' "expires" of+         (Just (tok, expt)) -> UserAccessToken userId tok (toExpire expt)+         _ -> error $ "userAccessTokenParser: failed to parse " ++ show bs+       where toExpire expt = let i = read (B8.unpack expt) :: Int+                             in addUTCTime (fromIntegral i) now+             userId = error "userAccessTokenParser: never here"   -- | The URL an user should be redirected to in order to log them@@ -236,19 +237,14 @@         let req = fbreq "/oauth/access_token" Nothing $                   tsq creds [ ("grant_type", "fb_exchange_token")                             , ("fb_exchange_token", data_) ]-        eresponse <- E.try (fbhttp req)+        eresponse <- E.try (asBS =<< fbhttp req)         case eresponse of           Right response -> do             now <- liftIO getCurrentTime-            either (Left . couldn'tParseExc) Right <$>-              E.try (lift $ H.responseBody response C.$$-                            C.sinkParser (userAccessTokenParser now))+            return (Right $ userAccessTokenParser now response)           Left exc -> return (Left exc)        hasExpiredExc =           mkExc [ "the user access token has already expired, "                 , "so I'll not try to extend it." ]-      couldn'tParseExc (exc :: C.ParseError) =-          mkExc [ "could not parse Facebook's response ("-                , T.pack (show exc), ")" ]       mkExc = FbLibraryException . T.concat . ("extendUserAccessToken: ":)

@@ -2,6 +2,7 @@     ( fbreq     , ToSimpleQuery(..)     , asJson+    , asBS     , FacebookException(..)     , fbhttp     , httpCheck@@ -16,8 +17,10 @@ import qualified Control.Exception.Lifted as E import qualified Data.Aeson as A import qualified Data.Attoparsec.Char8 as AT+import qualified Data.ByteString as B import qualified Data.Conduit as C import qualified Data.Conduit.Attoparsec as C+import qualified Data.Conduit.List as CL import qualified Data.Text as T import qualified Network.HTTP.Conduit as H import qualified Network.HTTP.Types as HT@@ -72,6 +75,13 @@              [ "Facebook.Base.asJson: could not parse "              , " Facebook's response as a JSON value ("              , T.pack str, ")" ]++-- | Converts a plain 'H.Response' into a string 'ByteString'.+asBS :: (C.ResourceThrow m, C.IsSource bsrc) =>+        H.Response (bsrc m ByteString)+     -> FacebookT anyAuth (C.ResourceT m) ByteString+asBS response = lift $ H.responseBody response C.$$ fmap B.concat CL.consume+   -- | An exception that may be thrown by functions on this