X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FTwitter%2FHttp.hs;h=3b834859f37fcdbeeec0892588024da794238d60;hp=14b03825a4d924663c8fd9ff4d17d56b1b9f56c0;hb=d721869c5e7395c021cc79f40720bdb275d613d2;hpb=bfe49b970e83f1d422d57ece7cebdfe7a56b817c diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index 14b0382..3b83485 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -1,92 +1,98 @@ module Twitter.Http where -import Network.Curl -import System.IO (hPutStrLn, stderr) +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Char8 as BC +import qualified Data.Conduit as C +import Data.Conduit.Binary (sinkLbs) +import Network.HTTP.Conduit +import Web.Authenticate.OAuth ( + OAuth(..), + Credential, + newCredential, + newOAuth, + signOAuth) + +import Configuration -- |The API URL of username's timeline. -- -- See, -- --- +-- -- user_timeline_url :: String -> String user_timeline_url username = - concat [ "http://api.twitter.com/1/statuses/user_timeline.xml", - "?screen_name=" ++ username, - "&include_rts=true", - "&count=10" ] + concat [ "https://api.twitter.com/", + "1.1/", + "statuses/", + "user_timeline.json?", + "screen_name=", + username, + "&include_rts=true&", + "count=10" ] status_url :: Integer -> String status_url status_id = - concat [ "http://api.twitter.com/1/statuses/show/", - (show status_id), - ".xml" ] - --- |Given username's last status id, constructs the API URL for --- username's new statuses. Essentially, 'user_timeline_url' with a --- "since_id" parameter tacked on. + concat [ "https://api.twitter.com/", + "1.1/", + "statuses/", + "show.json?id=", + (show status_id) ] + +-- | Given username's last status id, constructs the API URL for +-- username's new statuses. Essentially, 'user_timeline_url' with a +-- "since_id" parameter tacked on. user_new_statuses_url :: String -> Integer -> String user_new_statuses_url username last_status_id = - concat [ user_timeline_url username, - "&since_id=" ++ (show last_status_id) ] - + url ++ "&since_id=" ++ since_id + where + url = user_timeline_url username + since_id = show last_status_id -get_status :: Integer -> IO (Maybe String) -get_status status_id = do - let uri = (status_url status_id) - status <- (http_get uri) - return status +get_status :: Cfg -> Integer -> IO B.ByteString +get_status cfg status_id = do + let uri = status_url status_id + http_get cfg uri --- |Return's username's timeline, or 'Nothing' if there was an error. -get_user_timeline :: String -> IO (Maybe String) -get_user_timeline username = do - let uri = (user_timeline_url username) - timeline <- (http_get uri) - return timeline +-- | Return's username's timeline. +get_user_timeline :: Cfg -> String -> IO B.ByteString +get_user_timeline cfg username = do + let uri = user_timeline_url username + http_get cfg uri --- | Returns the XML representing all of username's statuses that are +-- | Returns the JSON representing all of username's statuses that are -- newer than last_status_id. -get_user_new_statuses :: String -> Integer -> IO (Maybe String) -get_user_new_statuses username last_status_id = do - let uri = (user_new_statuses_url username last_status_id) - new_statuses <- (http_get uri) - return new_statuses - - --- | Options that will be passed to every curl request. -curl_options :: [CurlOption] -curl_options = - [ CurlTimeout 45, - -- The Global cache is not thread-friendly. - CurlDNSUseGlobalCache False, - -- And we don't want to use a DNS cache anyway. - CurlDNSCacheTimeout 0 ] - - --- | Uses the CURL API to retrieve uri. Returns 'Nothing' if there was --- an error. -http_get :: String -> IO (Maybe String) -http_get uri = - withCurlDo $ do - -- Create a Curl instance. - curl <- initialize - - -- Perform the request, and get back a CurlResponse object. - -- The cast is needed to specify how we would like our headers - -- and body returned (Strings). - resp <- do_curl_ curl uri curl_options :: IO CurlResponse - - -- Pull out the response code as a CurlCode. - let code = respCurlCode resp - - case code of - CurlOK -> return $ Just (respBody resp) - error_code -> do - hPutStrLn stderr ("HTTP Error: " ++ (show error_code)) - -- If an error occurred, we want to dump as much information as - -- possible. If this becomes a problem, we can use respGetInfo to - -- query the response object for more information - return Nothing +get_user_new_statuses :: Cfg -> String -> Integer -> IO B.ByteString +get_user_new_statuses cfg username last_status_id = do + let uri = user_new_statuses_url username last_status_id + http_get cfg uri + + +-- | Retrieve a URL, or crash. +http_get :: Cfg -> String -> IO B.ByteString +http_get cfg url = do + manager <- newManager def + request <- parseUrl url + + C.runResourceT $ do + signed_request <- signOAuth oauth credential request + response <- http signed_request manager + responseBody response C.$$+- sinkLbs + + where + consumer_key' = BC.pack (consumer_key cfg) + consumer_secret' = BC.pack (consumer_secret cfg) + access_token' = BC.pack (access_token cfg) + access_secret' = BC.pack (access_secret cfg) + + oauth :: OAuth + oauth = newOAuth { + oauthConsumerKey = consumer_key', + oauthConsumerSecret = consumer_secret' + } + + credential :: Credential + credential = newCredential access_token' access_secret'