X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FTwitter%2FHttp.hs;h=6862ffc0f8f23b3d7485c2f82ea86da4ff21bf81;hp=14d156395426eed5bf40af35942ec220aa646762;hb=aa76db464725dace34b87f452f9ebb9675226e40;hpb=eed0d7b0f8ef28864c00925beef5c8853bcd44cc diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index 14d1563..6862ffc 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -1,29 +1,30 @@ module Twitter.Http ( get_user_new_statuses, get_user_timeline, - http_get - ) + http_get ) where -import qualified Data.ByteString.Lazy as B -import qualified Data.ByteString.Char8 as BC +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 ( - tlsManagerSettings) + responseBody ) +import Network.HTTP.Client.TLS ( mkManagerSettings ) import Web.Authenticate.OAuth ( OAuth(..), Credential, newCredential, newOAuth, - signOAuth) + signOAuth ) -import Configuration (Cfg(..)) +import Configuration ( Cfg(..) ) --- |The API URL of username's timeline. + +-- | The API URL of username's timeline. -- -- See, -- @@ -43,7 +44,13 @@ user_timeline_url username = -- | 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 @@ -53,6 +60,7 @@ user_new_statuses_url username last_status_id = -- | 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 @@ -60,17 +68,40 @@ 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 tlsManagerSettings + manager <- newManager novalidate_tls_manager_settings request <- parseUrl url signed_request <- signOAuth oauth credential request response <- httpLbs signed_request manager @@ -85,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'