Haskell で OAuth
hoauth があるけどこれまた使いにくい,というか自分には使い方がわからなかったので自分で書いた.
HTTP の Request_String を作るのでこんなかんじに使える.
import Control.Applicative ((<$>)) import Network.URI import Network.HTTP import qualified Text.JSON as J import Data.IntSet (IntSet) import qualified Data.IntSet as S import OAuth getFollowerIds :: OAuth -> IO (Either String IntSet) getFollowerIds oauth = J.resultToEither . J.decode <$> (genOAuthRequest oauth HMACSHA1 GET uri [] >>= simpleHTTP >>= getResponseBody) where Just uri = parseURI "http://api.twitter.com/1/followers/ids.json" postStatus :: OAuth -> String -> IO (Either String J.JSValue) postStatus oauth text = J.resultToEither . J.decode <$> (genOAuthRequest oauth HMACSHA1 POST uri [("status", text)] >>= simpleHTTP >>= getResponseBody) where Just uri = parseURI "http://api.twitter.com/1/statuses/update.json"
base64 のために dataenc,SHA1 のために SHA に依存しているので cabal 等で予めインストールしておく必要がある.
それ以外のパッケージは Haskell Platform に含まれているので改めてインストールする必要は無いはず.
OAuth の仕様から,HMAC-SHA1 のときの signature を生成する際に各パラメータをキーでソートしておく必要があるのを見落としていてしばらくハマったりしてた.
module OAuth ( genOAuthRequest , OAuth (..) , SignatureMethod (..) ) where import Data.List (sort, intercalate) import Control.Applicative ((<$>)) import System.Time (ClockTime(..), getClockTime) import System.Random (randomRIO) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8 import Network.URI import Network.HTTP import Data.Digest.Pure.SHA (hmacSha1, bytestringDigest) import qualified Codec.Binary.Base64 as B64 data OAuth = OAuth { consumerKey :: String , consumerSecret :: String , accessToken :: String , accessTokenSecret :: String } deriving (Show, Eq) data SignatureMethod = PLAINTEXT | HMACSHA1 deriving (Show) getUnixTime :: IO Integer getUnixTime = (\(TOD i _) -> i) <$> getClockTime encodeURIComponent :: String -> String encodeURIComponent = escapeURIString isUnreserved mkOAuthHeader :: [(String,String)] -> String mkOAuthHeader = ("OAuth " ++) . intercalate ", " . map (\(k,v) -> encodeURIComponent k ++ "=\"" ++ encodeURIComponent v ++ "\"") genOAuthRequest :: OAuth -> SignatureMethod -> RequestMethod -> URI -> [(String,String)] -> IO Request_String genOAuthRequest oauth sigMeth reqMeth uri params = do timestamp <- show <$> getUnixTime nonce <- show <$> randomRIO (0,maxBound::Int) let oauthParams = [ ("oauth_consumer_key", consumerKey oauth) , ("oauth_token", accessToken oauth) , ("oauth_signature_method", "HMAC-SHA1") , ("oauth_timestamp", timestamp) , ("oauth_nonce", nonce) , ("oauth_version", "1.0") ] key = consumerSecret oauth ++ "&" ++ accessTokenSecret oauth base = L8.pack . intercalate "&" . map encodeURIComponent $ [show reqMeth, show uri, urlEncodeVars (sort $ oauthParams ++ params)] sig = case sigMeth of PLAINTEXT -> key HMACSHA1 -> B64.encode . L.unpack . bytestringDigest $ hmacSha1 (L8.pack key) base hdr = mkOAuthHeader $ ("oauth_signature",sig):oauthParams q = urlEncodeVars params req = case reqMeth of GET -> Request { rqMethod = GET, rqHeaders = [] , rqBody = "" , rqURI = uri { uriQuery = '?' : q } } POST -> Request { rqMethod = POST, rqBody = q, rqURI = uri , rqHeaders = [ mkHeader HdrContentType "application/x-www-form-urlencoded" , mkHeader HdrContentLength (show $ length q) ] } _ -> Request { rqMethod = reqMeth, rqHeaders = [], rqBody = "" , rqURI = uri } return $ insertHeader HdrAuthorization hdr req