hoauth2-0.1.2: test/test-weibo.hs

{-# LANGUAGE OverloadedStrings #-}

{-

weibo oauth2: http://open.weibo.com/wiki/Oauth2

This is very trivial testing of the httpclient api.
1. this case will print out a URL
2. run the URL in browser and will navigate to weibo auth page
3. conform the authentication and browser will navigate back to the callback url,
   which obviously will failed cause there is no local server.
4. copy the `code` in the callback url and parse into console
5. this test case will gain access token using the `code` and print it out.

TODO:
  1. a simple local server in order to make the test automatically.
-}

module Main where

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)
          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"