hoauth2 0.1 → 0.1.2

raw patch · 3 files changed

+45/−17 lines, 3 files

Files

• hoauth2.cabal +1/−1
• src/Network/OAuth2/HTTP/HttpClient.hs +14/−14
• test/test-weibo.hs +30/−2

@@ -1,6 +1,6 @@ Name:                hoauth2 -- (http://www.haskell.org/haskellwiki/Package_versioning_policy)-Version:             0.1+Version:             0.1.2  Synopsis:            hoauth2 Description:         

@@ -10,6 +10,7 @@        , AccessToken (..)        , authorizationUrl        , postAccessToken+       , request        , signRequest        )        where@@ -53,9 +54,9 @@ authorizationUrl :: OAuth2 -> BS.ByteString authorizationUrl oa = oauthOAuthorizeEndpoint oa `BS.append` queryStr   where queryStr = renderSimpleQuery True query-        query = foldr step [] [ ("client_id", Just $ oauthClientId oa)-                              , ("response_type", Just "code")-                              , ("redirect_uri", oauthCallback oa)]+        query = transformParam [ ("client_id", Just $ oauthClientId oa)+                               , ("response_type", Just "code")+                               , ("redirect_uri", oauthCallback oa)]  request  :: Control.Monad.Trans.Resource.ResourceIO m =>             Request m -> m (Response BSL.ByteString)@@ -63,8 +64,6 @@  postAccessToken' :: OAuth2 -> BS.ByteString -> Maybe BS.ByteString -> IO BSL.ByteString postAccessToken' oa code grant_type = do-    print url-    print query     rsp <- request req     if (HT.statusCode . statusCode) rsp == 200         then return $ responseBody rsp@@ -72,17 +71,18 @@   where     req = urlEncodedBody query . fromJust $ parseUrl url     url = BS.unpack $ oauthAccessTokenEndpoint oa-    query = foldr step [] [ ("client_id", Just $ oauthClientId oa)+    query = transformParam [ ("client_id", Just $ oauthClientId oa)                           , ("client_secret", Just $ oauthClientSecret oa)                           , ("code", Just code)                           , ("redirect_uri", oauthCallback oa)                           , ("grant_type", grant_type) ] ---step :: (a, Maybe b) -> [(a, b)] -> [(a, b)]-step (a, Just b) xs = (a, b):xs-step _ xs = xs+-- | lift value in the Maybe and abonda Nothing+transformParam :: [(a, Maybe b)] -> [(a, b)]+transformParam = foldr step' []+                 where step' :: (a, Maybe b) -> [(a, b)] -> [(a, b)]+                       step' (a, Just b) xs = (a, b):xs+                       step' _ xs = xs  -- | Request (POST method) access token URL in order to get @AccessToken@. postAccessToken :: OAuth2 @@ -90,11 +90,11 @@                 -> IO (Maybe AccessToken) postAccessToken oa code = decode <$> postAccessToken' oa code (Just "authorization_code") --- | +-- | insert access token into the request signRequest :: OAuth2 -> Request m -> Request m-signRequest oa req = req { queryString = (renderSimpleQuery False newQuery) }+signRequest oa req = req { queryString = renderSimpleQuery False newQuery }   where     newQuery = case oauthAccessToken oa of-                    Just at -> insert ("oauth_token", at) oldQuery+                    Just at -> insert ("access_token", at) oldQuery   -- ^ TODO: allow access_token to be configuable                     _ -> insert ("client_id", oauthClientId oa) . insert ("client_secret", oauthClientSecret oa) $ oldQuery     oldQuery = parseSimpleQuery (queryString req)

@@ -21,17 +21,45 @@ import Network.OAuth2.HTTP.HttpClient import qualified Data.ByteString.Char8 as BS import WeiboKey+import Data.Maybe (fromJust) +import Control.Monad.Trans+import Control.Monad.Trans.Resource+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Network.HTTP.Types as HT+import Network.HTTP.Conduit+import Control.Exception+import Control.Applicative ((<$>))+import Control.Monad (mzero)+ weibooauth :: OAuth2 weibooauth = weiboKey { oauthOAuthorizeEndpoint = "https://api.weibo.com/oauth2/authorize"                       , oauthAccessTokenEndpoint = "https://api.weibo.com/oauth2/access_token"                        , oauthAccessToken = Nothing                       } +urlToRequest = fromJust . parseUrl++accountUidReq = urlToRequest "https://api.weibo.com/2/account/get_uid.json"++-- | send a request and get a response body if successfully otherwise error+sendRequest :: Request IO -> IO BSL.ByteString+sendRequest req = do+    rsp <- request req+    if (HT.statusCode . statusCode) rsp == 200+        then return $ responseBody rsp+        else return $ BSL.pack $ "Error when requesting: " ++ BSL.unpack (responseBody rsp)+  +-- | fetch UID     main :: IO () main = do            print $ authorizationUrl weibooauth           putStr "visit the url and paste code here: "           code <- getLine-          token <- postAccessToken weibooauth (BS.pack code) -          print token+          token <- postAccessToken weibooauth (BS.pack code)+          case token of +            Just (AccessToken token') -> do+                                         req <- return $ signRequest (weibooauth { oauthAccessToken = Just token'} ) accountUidReq+                                         print (queryString req)+                                         sendRequest req >>= print+            _ -> print "no token found"