hoauth2 0.4.5 → 0.4.6

raw patch · 6 files changed

+58/−31 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• example/Douban/test.hs +2/−0
• example/Facebook/test.hs +8/−4
• example/Google/test.hs +5/−2
• example/Weibo/test.hs +1/−1
• hoauth2.cabal +3/−3
• src/Network/OAuth/OAuth2/HttpClient.hs +39/−21

@@ -5,6 +5,8 @@  douban oauth2: http://developers.douban.com/wiki/?title=oauth2 +/v2/movie/nowplaying+ -}  module Main where

@@ -36,9 +36,13 @@     code <- fmap BS.pack getLine     mgr <- newManager conduitManagerSettings     let (url, body) = accessTokenUrl facebookKey code-    (Right token) <- doJSONPostRequest mgr facebookKey url (body ++ [("state", "test")])-    userinfo mgr token >>= print-    userinfo' mgr token >>= print+    resp <- doJSONPostRequest mgr facebookKey url (body ++ [("state", "test")])+    print (resp :: OAuth2Result AccessToken)+    case resp of+      Right token -> print token+        --userinfo mgr token >>= print+        --userinfo' mgr token >>= print+      Left l -> print l     closeManager mgr  --------------------------------------------------@@ -50,7 +54,7 @@  -- | Fetch user id and email. userinfo :: Manager -> AccessToken -> IO (OAuth2Result BL.ByteString)-userinfo mgr token = authGetBS mgr token "https://graph.facebook.com/me?fields=id,name,email&"+userinfo mgr token = authGetBS mgr token "https://graph.facebook.com/me?fields=id,name,email"  userinfo' :: FromJSON User => Manager -> AccessToken -> IO (OAuth2Result User) userinfo' mgr token = authGetJSON mgr token "https://graph.facebook.com/me?fields=id,name,email"

@@ -16,6 +16,7 @@ import           Keys                          (googleKey) import           Network.OAuth.OAuth2 +import           Control.Monad                 (liftM) import           Data.Aeson                    (FromJSON) import           Data.Aeson.TH                 (defaultOptions, deriveJSON) import qualified Data.ByteString.Char8         as BS@@ -124,13 +125,15 @@ validateToken :: Manager                  -> AccessToken                  -> IO (OAuth2Result BL.ByteString)-validateToken mgr token = authGetBS mgr token "https://www.googleapis.com/oauth2/v1/tokeninfo"+validateToken mgr token =+   authGetBS' mgr token url+   where url = "https://www.googleapis.com/oauth2/v1/tokeninfo"  validateToken' :: FromJSON a                   => Manager                   -> AccessToken                   -> IO (OAuth2Result a)-validateToken' mgr token = authGetJSON mgr token "https://www.googleapis.com/oauth2/v1/tokeninfo"+validateToken' mgr token = liftM parseResponseJSON $ validateToken mgr token  -- | fetch user email. --   for more information, please check the playround site.

@@ -39,7 +39,7 @@        print token        case token of          Right r -> do-                    uid <- authGetBS mgr r "https://api.weibo.com/2/account/get_uid.json"+                    uid <- authGetBS' mgr r "https://api.weibo.com/2/account/get_uid.json"                     print uid          Left l -> BSL.putStrLn l        closeManager mgr

@@ -1,6 +1,6 @@ Name:                hoauth2 -- (http://www.haskell.org/haskellwiki/Package_versioning_policy)-Version:             0.4.5+Version:             0.4.6  Synopsis:            hoauth2 Description:@@ -18,8 +18,8 @@ License:             BSD3 License-file:        LICENSE Author:              Haisheng Wu-Maintainer:          freizl@gmail.com-Copyright:           Haisheng,Wu+Maintainer:          Haisheng Wu <freizl@gmail.com>+Copyright:           Haisheng Wu Category:            Network Build-type:          Simple stability:           alpha

@@ -66,6 +66,7 @@ --------------------------------------------------  -- | Conduct GET request and return response as JSON.+-- authGetJSON :: FromJSON a                  => Manager                      -- ^ HTTP connection manager.                  -> AccessToken@@ -74,15 +75,28 @@ authGetJSON manager t uri = liftM parseResponseJSON $ authGetBS manager t uri  -- | Conduct GET request.+-- authGetBS :: Manager                              -- ^ HTTP connection manager.              -> AccessToken              -> URI                               -- ^ URL              -> IO (OAuth2Result BSL.ByteString)  -- ^ Response as ByteString-authGetBS manager token url = liftM handleResponse go-                      where go = do-                                 req <- parseUrl $ BS.unpack $ url `appendAccessToken` token-                                 authenticatedRequest manager token HT.GET req+authGetBS manager token url = do+  req <- parseUrl $ BS.unpack url+  authRequest req upReq manager+  where upReq = updateRequestHeaders (Just token) . setMethod HT.GET +-- | same to 'authGetBS' but set access token to query parameter rather than header+--+authGetBS' :: Manager                              -- ^ HTTP connection manager.+             -> AccessToken+             -> URI                               -- ^ URL+             -> IO (OAuth2Result BSL.ByteString)  -- ^ Response as ByteString+authGetBS' manager token url = do+  req <- parseUrl $ BS.unpack $ url `appendAccessToken` token+  authRequest req upReq manager+  where upReq = updateRequestHeaders Nothing . setMethod HT.GET++ -- | Conduct POST request and return response as JSON. authPostJSON :: FromJSON a                  => Manager                      -- ^ HTTP connection manager.@@ -98,28 +112,27 @@              -> URI                               -- ^ URL              -> PostBody              -> IO (OAuth2Result BSL.ByteString)  -- ^ Response as ByteString-authPostBS manager token url pb = liftM handleResponse go-                          where body = pb ++ accessTokenToParam token-                                go = do-                                     req <- parseUrl $ BS.unpack url-                                     authenticatedRequest manager token HT.POST $  urlEncodedBody body req-+authPostBS manager token url pb = do+  req <- parseUrl $ BS.unpack url+  authRequest req upReq manager+  where upBody = urlEncodedBody (pb ++ accessTokenToParam token)+        upHeaders = updateRequestHeaders (Just token) . setMethod HT.POST+        upReq = upHeaders . upBody  -- |Sends a HTTP request including the Authorization header with the specified --  access token. ---authenticatedRequest :: Manager                          -- ^ HTTP connection manager.-                     -> AccessToken                      -- ^ Authentication token to use-                     -> HT.StdMethod                     -- ^ Method to use-                     -> Request        -- ^ Request to perform-                     -> IO (Response BSL.ByteString)-authenticatedRequest manager token m r =-    httpLbs (updateRequestHeaders (Just token) $ setMethod m r) manager+authRequest :: Request                          -- ^ Request to perform+               -> (Request -> Request)          -- ^ Modify request before sending+               -> Manager                          -- ^ HTTP connection manager.+               -> IO (OAuth2Result BSL.ByteString)+authRequest req upReq manager = liftM handleResponse (authRequest' req upReq manager) --- | Sets the HTTP method to use----setMethod :: HT.StdMethod -> Request -> Request-setMethod m req = req { method = HT.renderStdMethod m }+authRequest' :: Request                          -- ^ Request to perform+               -> (Request -> Request)          -- ^ Modify request before sending+               -> Manager                          -- ^ HTTP connection manager.+               -> IO (Response BSL.ByteString)+authRequest' req upReq = httpLbs (upReq req)  -------------------------------------------------- -- * Utilities@@ -156,3 +169,8 @@       headers = bearer ++ extras ++ requestHeaders req   in   req { requestHeaders = headers }++-- | Sets the HTTP method to use+--+setMethod :: HT.StdMethod -> Request -> Request+setMethod m req = req { method = HT.renderStdMethod m }