ConduitでTwitterのAPIを叩く

まさかのconduit-1.0.0がリリースされどうなることかと思ったが、意外と簡単に実装できた。

{-# LANGUAGE OverloadedStrings #-}
import Web.Authenticate.OAuth as OAuth -- authenticate-oauth-1.4.0.4
import qualified Data.Aeson as JSON    -- aeson-0.6.1.0
import Data.Conduit                    -- conduit-1.0.0
import Network.HTTP.Conduit            -- http-conduit-1.9.0
import Network.HTTP.Types              -- http-types-0.8.0
import Network (withSocketsDo)

oauth :: OAuth.OAuth
oauth = OAuth.newOAuth
    { OAuth.oauthServerName = "twitter"
    , OAuth.oauthRequestUri = "https://twitter.com/oauth/request_token"
    , OAuth.oauthAccessTokenUri = "https://api.twitter.com/oauth/access_token"
    , OAuth.oauthAuthorizeUri = "https://api.twitter.com/oauth/authorize"
    , OAuth.oauthSignatureMethod = OAuth.HMACSHA1
    , OAuth.oauthConsumerKey = error "Consumer key"
    , OAuth.oauthConsumerSecret = error "Consumer secret"
    , OAuth.oauthVersion         = OAuth.OAuth10a
    }

endpoint x = "https://api.twitter.com/1.1/" ++ x ++ ".json"

fetch :: Method -> Credential -> String -> SimpleQuery -> IO JSON.Value
fetch mth cred p q = withManager $ \man -> do
    req <- parseUrl (endpoint p)
    req' <- signOAuth oauth cred (req {method=mth,queryString = renderSimpleQuery True q})
    res <- httpLbs req' man
    maybe (fail "JSON decoding error") return $ JSON.decode (responseBody res)

fetchGET = fetch methodGet
fetchPOST = fetch methodPost

main = withSocketsDo $ do
    let cred = newCredential (error "Access token") (error "Access token secret")
    result <- fetchGET cred "users/show" [("screen_name", "fumieval")]
    print result