X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FTwitter%2FHttp.hs;h=6862ffc0f8f23b3d7485c2f82ea86da4ff21bf81;hp=3b834859f37fcdbeeec0892588024da794238d60;hb=aa76db464725dace34b87f452f9ebb9675226e40;hpb=d721869c5e7395c021cc79f40720bdb275d613d2 diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index 3b83485..6862ffc 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -1,21 +1,30 @@ -module Twitter.Http +module Twitter.Http ( + get_user_new_statuses, + get_user_timeline, + http_get ) where -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 qualified Data.ByteString.Lazy as B ( ByteString ) +import qualified Data.ByteString.Char8 as BC ( pack ) +import Network.Connection ( TLSSettings(..) ) +import Network.HTTP.Client ( + ManagerSettings, + httpLbs, + newManager, + parseUrl, + responseBody ) +import Network.HTTP.Client.TLS ( mkManagerSettings ) import Web.Authenticate.OAuth ( OAuth(..), Credential, newCredential, newOAuth, - signOAuth) + signOAuth ) -import Configuration +import Configuration ( Cfg(..) ) --- |The API URL of username's timeline. + +-- | The API URL of username's timeline. -- -- See, -- @@ -32,17 +41,16 @@ user_timeline_url username = "&include_rts=true&", "count=10" ] -status_url :: Integer -> String -status_url status_id = - 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. +-- \"since_id\" parameter tacked on. +-- +-- Examples: +-- +-- >>> user_new_statuses_url "someuser" 8675309 +-- "https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name=someuser&include_rts=true&count=10&since_id=8675309" +-- user_new_statuses_url :: String -> Integer -> String user_new_statuses_url username last_status_id = url ++ "&since_id=" ++ since_id @@ -50,13 +58,9 @@ user_new_statuses_url username last_status_id = url = user_timeline_url username since_id = show last_status_id -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. +-- get_user_timeline :: Cfg -> String -> IO B.ByteString get_user_timeline cfg username = do let uri = user_timeline_url username @@ -64,23 +68,44 @@ get_user_timeline cfg username = do -- | Returns the JSON representing all of username's statuses that are --- newer than last_status_id. +-- newer than @last_status_id@. +-- 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. +-- | The default 'tlsManagerSettings' attempts to verify the +-- certificate that we get from the server, but it's quite pointless +-- for our purposes. +-- +-- The default 'tlsManagerSettings' is constructed is like, +-- +-- tlsManagerSettings = mkManagerSettings def Nothing +-- +-- and the 'def' passes in a 'TLSSettings' from +-- \"Network.Connection\". By constructing our own 'TLSSettings', we +-- can disable the certificate validation. +-- +novalidate_tls_manager_settings :: ManagerSettings +novalidate_tls_manager_settings = + mkManagerSettings mytls Nothing + where + -- The first field is "disable validation" + mytls = TLSSettingsSimple True False False + + +-- | Retrieve a URL, or crash. The request is signed using all of the +-- OAuth junk contained in the configuration. +-- http_get :: Cfg -> String -> IO B.ByteString http_get cfg url = do - manager <- newManager def + manager <- newManager novalidate_tls_manager_settings request <- parseUrl url - - C.runResourceT $ do - signed_request <- signOAuth oauth credential request - response <- http signed_request manager - responseBody response C.$$+- sinkLbs + signed_request <- signOAuth oauth credential request + response <- httpLbs signed_request manager + return $ responseBody response where consumer_key' = BC.pack (consumer_key cfg) @@ -91,8 +116,7 @@ http_get cfg url = do oauth :: OAuth oauth = newOAuth { oauthConsumerKey = consumer_key', - oauthConsumerSecret = consumer_secret' - } + oauthConsumerSecret = consumer_secret' } credential :: Credential credential = newCredential access_token' access_secret'