Haskellのコード150行で, Twitterに投稿するだけのクライアントを作ったよ

Haskell

Haskell触り始めて三ヶ月ほど経ったー

プログラミング自体を始めて, 一年半くらいー (だいたい

3日前, こんな夢を見たんだ


せんぱーいwww プログラム書いててwww OAuth触れないのってwww 笑ってませんよ?wwww
　　ちょ、ちょっとごめんなさいｗｗｗ あはははｗｗｗ　…ぷっｗ (*´pq｀)


ってことで, Haskellで, Twitterに投稿するだけのクライアントを書いてみたよ

Haskellでリクエストトークンを拾ったりそういうところのコードが, あまりネットで探しても無い気がするので...

再利用なんてなかった!!! ←おいっ

参考文献

偉大なるid:eagletmt, id:kenkov両氏に感謝!
というか, コードの大半は両者のブログに載ってたもの...

OAuthはここ見りゃ全て分かる. と言うか仕様を見ればいいんだが (ry

依存ライブラリ

sudo cabal install dataenc utf8-string SHA urlencoded cgi http

きちんとcabalを最新にしてからインストールしてくださいね

注意事項

Haskell歴の浅い自分が書いたコードなので, 色々とオカシイかも知れないよ → ツッコミ歓迎

OAuthの仕様に, もしかしたら反してるかも知れないよ

将来, ライブラリーの変更か, TwitterのAPIの変更により, 動かなく可能性もあるよ


ソースコード

取り敢えず, ソースコードだよっ
全部qualifiedなのは, 後で検索しやすいようにだよっ

import Prelude
import qualified Codec.Binary.Base64          as B64
import qualified Codec.Binary.UTF8.String     as UTF8
import qualified Control.Exception            as CE
import qualified Data.ByteString.Lazy         as Lazy
import qualified Data.ByteString.Lazy.Char8   as LC8
import qualified Data.Digest.Pure.SHA         as SHA
import qualified Data.List                    as List
import qualified Data.Maybe                   as Maybe
import qualified Data.URLEncoded              as URLEncoded
import qualified Network                      as Network
import qualified Network.CGI                  as CGI
import qualified Network.HTTP                 as HTTP
import qualified Network.HTTP.Base            as HTTPBase
import qualified Network.URI                  as URI
import qualified System.Directory             as SD
import qualified System.Random                as Random
import qualified System.Time                  as Time

type Token         = String
type TokenSecret   = String
type PIN           = String
type URL           = String
type Key           = String
type Signature     = String
type Parameters    = [(String, String)]
data OAuth = OAuth { key            :: String
                   , secret         :: String
                   , token          :: String
                   , tokenSecret    :: String
                   }

-- * これらは, アプリケーションを作ったときにTwitterにもらったものだよ (参考: https://dev.twitter.com/apps
consumerKey        = "VgF3Q57PdAfBnkM8FPaRQ"
consumerSecret     = "XEgtRkfmCMEQhR7WToDH8meXmKT5CfUXKOBVtdkNlA"

apiURL             = "http://api.twitter.com"
requestTokenURL    = apiURL ++ "/oauth/request_token"
authorizationURL   = apiURL ++ "/oauth/authorize"
accessTokenURL     = apiURL ++ "/oauth/access_token"
updateURL          = apiURL ++ "/1/statuses/update.json"
homeTimelineURL    = apiURL ++ "/1/statuses/home_timeline.json"
fileName           = "/.hs_twitter_token.txt" 
getSettingFilePath = SD.getHomeDirectory >>= return . (++fileName)   -- 設定ファイルは ~/.hs_twitter_token.txt だよ. おかしくなったらこのファイルを消してね.

encodeURIComponent :: String -> String
encodeURIComponent = URI.escapeURIString URI.isUnreserved

genSignature :: URL -> Key -> HTTPBase.RequestMethod -> Parameters -> Signature
genSignature url key method params =                       -- * 署名を生成するよ
  let base = LC8.pack . List.intercalate "&" . map encodeURIComponent $
                      [show method, url, HTTP.urlEncodeVars $ List.sort params]  -- ソートするのを忘れないようにね
  in B64.encode . Lazy.unpack . SHA.bytestringDigest $ SHA.hmacSha1 (LC8.pack key) base

genOAuthParams :: IO Parameters
genOAuthParams = do
  unixTime <- fmap (show . \(Time.TOD i _) -> i) Time.getClockTime
  nounce   <- fmap show $ Random.randomRIO (0, maxBound::Int)
  return [("oauth_consumer_key"    , consumerKey )
         ,("oauth_signature_method", "HMAC-SHA1" )
         ,("oauth_timestamp"       , unixTime    )
         ,("oauth_nonce"           , nounce      )
         ,("oauth_version"         , "1.0"       )]

genOAuthURL :: URL -> Signature -> Parameters -> URL
genOAuthURL base signature params =                        -- * パラメータに署名をくっつけて, ソートした上で, URLエンコードして, くっつけるよ
  base ++ "?" ++ (HTTP.urlEncodeVars $ List.sort $ ("oauth_signature", signature) : params)

genOAuthRequest :: OAuth -> URL -> HTTPBase.RequestMethod -> Parameters -> IO HTTP.Request_String
genOAuthRequest oauth url method params = do               -- * 一般に, OAuthリクエストを作るよ. 色々と使えるよ.
  oauthparams <- genOAuthParams
  let allparams   = oauthparams ++ params ++ (if token oauth == "" then [] else [("oauth_token", token oauth)])
      sigkey      = secret oauth ++ "&" ++ tokenSecret oauth     -- 署名のためのキーだよ
      signature   = genSignature url sigkey method $ allparams   -- 全てのパラメータを元に, 署名を作るよ
      oauthURL    = genOAuthURL url signature allparams          -- URLを作るよ
  return HTTP.Request { HTTPBase.rqURI     = Maybe.fromJust $ URI.parseURI oauthURL
                      , HTTPBase.rqMethod  = method
                      , HTTPBase.rqHeaders = [HTTP.mkHeader HTTP.HdrAuthorization "OAuth"]
                      , HTTPBase.rqBody    = "" }

getRequestToken :: OAuth -> IO HTTP.Request_String         -- * リクエストトークンをもらうよ
getRequestToken oauth       = genOAuthRequest oauth requestTokenURL HTTPBase.GET  []

getAccessToken :: OAuth -> PIN -> IO HTTP.Request_String   -- * アクセストークンをもらうよ
getAccessToken oauth pin    = genOAuthRequest oauth accessTokenURL  HTTPBase.GET  [("oauth_verifier", pin)]

updateStatus :: OAuth -> String -> IO HTTP.Request_String  -- * Twitterにポストするよ. rqMethodはPOSTだよ. UTF8.encodeStringを使うのは, 日本語のためだよ
updateStatus oauth status   = genOAuthRequest oauth updateURL       HTTPBase.POST [("status", UTF8.encodeString status)]

getHomeTimeLine :: OAuth -> IO HTTP.Request_String
getHomeTimeLine oauth       = genOAuthRequest oauth homeTimelineURL HTTPBase.GET  []

lookupFromResponse :: [Key] -> String -> [String]
lookupFromResponse keys res = map (Maybe.fromJust . flip lookup (CGI.formDecode res)) keys

mainloop :: OAuth -> IO ()                                 -- * 呟くぞーーーーー ｢･ω･)｢ >>= >>= >>= >>= >>= >>=
mainloop oauth = getLine >>= updateStatus oauth >>= HTTP.simpleHTTP >>= HTTP.getResponseBody >> mainloop oauth

initialSettings :: IO ()                                   -- * 初めて使うときの設定だよ
initialSettings = do    
  -- * リクエストトークンをもらうよ
  let oauth = OAuth { key         = consumerKey     -- consumer keyと,
                    , secret      = consumerSecret  --    consumer secret は, アプリケーションを登録したときにもらったものだよ
                    , token       = ""     -- ここは何もないよ (genOAuthRequestの中で消してるよ)
                    , tokenSecret = "" }
  request   <- getRequestToken oauth
  result    <- HTTP.simpleHTTP request
  response  <- HTTP.getResponseBody result
  putStrLn $ "リクエストトークンをたぶんうまく取得できたよ"

  -- * さっきもらったリクエストトークンを, URLにくっつけて, ユーザーに許可を求めるよ
  let reqToken:reqTokenSecret:_ = lookupFromResponse ["oauth_token", "oauth_token_secret"] response
      url = authorizationURL ++ "?" ++ HTTP.urlEncodeVars [("oauth_token", reqToken)]
  putStrLn $ "このURLにアクセスしてね " ++ url
  putStrLn $ "PINを入力してね"
  pin <- getLine   -- ユーザーにPINをもらうよ

  -- * アクセストークンをもらうよ
  let oauth = OAuth { key         = consumerKey
                    , secret      = consumerSecret
                    , token       = reqToken
                    , tokenSecret = reqTokenSecret }
  acc_request   <- getAccessToken oauth pin -- oauth_verifier にユーザーがもらってきたPINコードをくっつけるよ
  acc_result    <- HTTP.simpleHTTP acc_request
  acc_response  <- HTTP.getResponseBody acc_result
  path <- getSettingFilePath
  writeFile path acc_response  -- アクセストークンその他を, ホームディレクトリ下に保存しておくよ

restoreOAuthFromFile :: IO OAuth                           -- * ローカルファイルからOAuth設定を読み込むよ. 場合によっては, 初期設定をするよ.
restoreOAuthFromFile = do
  CE.catch (do path <- getSettingFilePath
               dat <- readFile path      -- 設定ファイルを読むよ
               let accToken:accTokenSecret:screenName:_ =
                           lookupFromResponse ["oauth_token", "oauth_token_secret", "screen_name"] dat
                   oauth = OAuth { key         = consumerKey
                                 , secret      = consumerSecret
                                 , token       = accToken
                                 , tokenSecret = accTokenSecret }
               putStrLn "設定をうまく読み込めたよ"
               return oauth)
           (\e -> do return (e :: CE.SomeException)
                     putStrLn "ローカルファイルから設定をうまくロード出来なかったよ"  -- ファイルがないか, lookupfromresponseで(fromJustで)失敗した時だよ
                     initialSettings
                     restoreOAuthFromFile)                      -- 初期設定をしてから, もっかいこの関数を呼ぶよ)

main :: IO ()
main = do
  oauth <- restoreOAuthFromFile
  CE.catch (mainloop oauth) (\e -> return (e :: CE.SomeException) >> return ())  -- mainloopを, Ctrl-Cで抜けるよ

＼ぴったり150行／

実行結果

必要ライブラリーがちゃんと入っていたら, runhaskellで多分実行できるよ

一度初期設定をしたら, 二度目以降の起動は~/.hs_twitter_token.txtからアクセストークンを読み込むよ


おわりに

｢･ω･)｢ がおー >>= >>= >>= >>= >>=

Haskell楽しいね

ところでUser StreamsをHaskellで開くのってどうすればいいんだろう...