ClackのミドルウェアでOAuth認証: Twitterログインしてみる

Clackのチュートリアル を読んだところ、アプリケーション本体に前処理と後処理をかぶせるミドルウェアという仕組みがあるらしい。ミドルウェアにはセッション管理やロガーなどが用意されていて、自分で書くこともできる。
ミドルウェアの中に、CLACK.MIDDLEWARE.OAUTHというOAuth認証をやってくれるものを見つけたので早速試してみた。cl-oauthによるTwitterログインとsrc/contrib/middleware/oauth.lispを読み比べると、リクエストトークンの取得から認証ページへのジャンプ、コールバックの際のGETパラメータからアクセストークンオブジェクトを作るところまでミドルウェアがうまいこと隠してくれているのが分かる。

前準備として、Twitterのページでアプリを生成する。

• Twitterの開発者向けのページを開き、Create New Appを押す
• アプリの名前とかを入力。今回は "clack-oauth-test" とした。その後既約に同意して作成完了。Callback URLはリクエストトークンに入れて送るので本当はいらないけど、とりあえず何か入力しておかないとエラーになるので注意。
• 次に作成されたアプリの管理画面に入るので、API Keysタブを選択し、API keyとAPI secretをメモる。これがconsumer-keyとconsumer-secretとなる。

cl-oauthでAPIにリクエストを出すときにパラメータが入っているとエラーになるバグがあったので修正を送ってマージしてもらった。まだQuicklispに反映されてないので、githubにある最新版を入れる。

$ cd ~/quicklisp/local-projects/
$ git clone https://github.com/skypher/cl-oauth.git

次にQuicklispからClackとCLACK.MIDDLEWARE.OAUTHをインストール

(ql:quickload :clack)
(ql:quickload :clack-middleware-oauth)

作業用のパッケージを作っておく

(defpackage :clack-oauth-test
  (:use :common-lisp :clack :clack.middleware.oauth))

(in-package :clack-oauth-test)

次に、アプリ本体の関数とコールバック関数を定義する。
コールバック関数はOAuth認証が成功した時に呼ばれる関数で、リクエストと取得したアクセストークンを引数に取り、本体の関数と同様の返り値を返す。とりあえずここではコールバック関数はアクセストークンを変数に保存するだけ。

(defun app (env)
  '(200                           ; HTTPステータスコード
    (:content-type "text/plain")  ; Content-type
    ("Hello, Clack!")))           ; 中身

(defvar *request*)
(defvar *access-token*)

;; 認証成功時に呼ばれる関数
(defun callback (request access-token)
  (setf *request* request)
  (setf *access-token* access-token)
  '(200
    (:content-type "text/plain")
    ("Authorized!")))

次に、アプリ本体の関数にミドルウェアをかぶせてサーバを起動する。
のスロットに、Twitterの開発者ページでメモったconsumer-keyやconsumer-secretを入れる。authorize-uri、request-token-uri、access-token-uriにはAPI毎に指定されたアドレスを入れる。Twitterの場合はこれである。callback-baseにpathをつなげた http://localhost:5000/auth が認証のためのアドレスであり、コールバックURLとなる。clackupはデフォルトで5000番のポートを使う。

;; サーバを起動する
(defparameter handler
  (clackup
   (wrap
    (make-instance '<clack-middleware-oauth>
       :consumer-key "xxxxxxxxxxxxxxxxxxxxxxxxx"
       :consumer-secret "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
       :authorize-uri "https://api.twitter.com/oauth/authorize"
       :request-token-uri "https://api.twitter.com/oauth/request_token"
       :access-token-uri "https://api.twitter.com/oauth/access_token"
       :path "/auth"
       :callback-base "http://localhost:5000"
       :authorized #'callback)
    #'app)))

;; サーバを止める。app等を更新したときは、サーバを一旦止めて、再びclackupする
; (stop handler)

この状態で http://localhost:5000 にアクセスすると、app関数の"Hello, Clack!"が表示され、 http://localhost:5000/auth にアクセスするとTwitterの認証ページに飛ばされる。認証が完了するとhttp://localhost:5000/authに戻ってきて、"Authorized!"が表示される。

この時点で*access-token*に取得したアクセストークンが入っている。

CLACK-OAUTH-TEST> *access-token*
#<CL-OAUTH:ACCESS-TOKEN 
  :CONSUMER #<CL-OAUTH:CONSUMER-TOKEN 
  :KEY "xxxxxxxxxxxxxxxxxxxxxxxxxx"
  :SECRET "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
  :USER-DATA NIL
  :LAST-TIMESTAMP 0>
  :KEY "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
  :SECRET "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
  :USER-DATA (("user_id" . "49735943") ("screen_name" . "masatoi0"))
  :SESSION-HANDLE NIL
  :EXPIRES NIL
  :AUTHORIZATION-EXPIRES NIL
  :ORIGIN-URI "https://api.twitter.com/oauth/access_token">

アクセストークンが取得できたので、APIからホームタイムラインやキーワード検索を引っ張ってこれるようになった。

(ql:quickload :cl-json)
(ql:quickload :babel)

(defun home-timeline (access-token &key (count 20) since-id max-id)
  (json:decode-json-from-string
   (babel:octets-to-string
    (oauth:access-protected-resource
     "https://api.twitter.com/1.1/statuses/home_timeline.json"
     access-token
     :user-parameters (remove-if #'null
				 (list
				  (cons "count" (format nil "~D" (truncate count)))
				  (if since-id (cons "since_id" (format nil "~D" (truncate since-id))))
				  (if max-id (cons "max_id" (format nil "~D" (truncate max-id))))))))))

(defun search-twitter (access-token keyword &key (count 20) since-id max-id lang)
  (json:decode-json-from-string
   (babel:octets-to-string
    (oauth:access-protected-resource
     "https://api.twitter.com/1.1/search/tweets.json"
     access-token
     :user-parameters (remove-if #'null
				 (list
				  (cons "q" keyword)
				  (cons "count" (format nil "~D" (truncate count)))
				  ; (cons "result_type" "popular") ; "mixed" "recent"
				  (if since-id (cons "since_id" (format nil "~D" (truncate since-id))))
				  (if max-id (cons "max_id" (format nil "~D" (truncate max-id))))
				  (if lang (cons "lang" lang)) ; ja や en など
				  ))))))

REPLでhome-timelineを評価してみると

CLACK-OAUTH-TEST> (home-timeline *access-token*)
(((:CREATED--AT . "Thu Aug 28 08:53:36 +0000 2014") (:ID . 504914685481590786)
  (:ID--STR . "504914685481590786")
  (:TEXT . "ClackのミドルウェアでTwitterのOAuth認証してみる")
  (:SOURCE
   . "<a href=\"http://twitter.com\" rel=\"nofollow\">Twitter Web Client</a>")
  (:TRUNCATED) (:IN--REPLY--TO--STATUS--ID) (:IN--REPLY--TO--STATUS--ID--STR)
  (:IN--REPLY--TO--USER--ID) (:IN--REPLY--TO--USER--ID--STR)
  (:IN--REPLY--TO--SCREEN--NAME)
  (:USER (:ID . 49735943) (:ID--STR . "49735943") (:NAME . "Satoshi Imai")
   (:SCREEN--NAME . "masatoi0") (:LOCATION . "Tokyo, Suginami")
   (:DESCRIPTION
    . "NAIST→マイクロ法人経営中。最近はFX/CFDトレードシステムを作ったりしてブラブラしてます。機械学習/AI/LISP/FreeBSD/Webプログラミング/金融工学")
   (:URL . "http://t.co/PAlHGDEvXc")
   (:ENTITIES
    (:URL
     (:URLS
      ((:URL . "http://t.co/PAlHGDEvXc")
       (:EXPANDED--URL . "http://d.hatena.ne.jp/masatoi/")
       (:DISPLAY--URL . "d.hatena.ne.jp/masatoi/") (:INDICES 0 22))))
    (:DESCRIPTION (:URLS)))
   (:PROTECTED) (:FOLLOWERS--COUNT . 192) (:FRIENDS--COUNT . 232)
   (:LISTED--COUNT . 23) (:CREATED--AT . "Mon Jun 22 19:31:26 +0000 2009")
   (:FAVOURITES--COUNT . 254) (:UTC--OFFSET . 32400) (:TIME--ZONE . "Tokyo")
   (:GEO--ENABLED) (:VERIFIED) (:STATUSES--COUNT . 3082) (:LANG . "ja")
   (:CONTRIBUTORS--ENABLED) (:IS--TRANSLATOR) (:IS--TRANSLATION--ENABLED)
   (:PROFILE--BACKGROUND--COLOR . "D9D9D9")
   (:PROFILE--BACKGROUND--IMAGE--URL
    . "http://abs.twimg.com/images/themes/theme1/bg.png")
   (:PROFILE--BACKGROUND--IMAGE--URL--HTTPS
    . "https://abs.twimg.com/images/themes/theme1/bg.png")
   (:PROFILE--BACKGROUND--TILE)
   (:PROFILE--IMAGE--URL
    . "http://pbs.twimg.com/profile_images/501986906893082625/kP1VOc48_normal.png")
   (:PROFILE--IMAGE--URL--HTTPS
    . "https://pbs.twimg.com/profile_images/501986906893082625/kP1VOc48_normal.png")
   (:PROFILE--LINK--COLOR . "877E28")
   (:PROFILE--SIDEBAR--BORDER--COLOR . "000000")
   (:PROFILE--SIDEBAR--FILL--COLOR . "DCDEF5")
   (:PROFILE--TEXT--COLOR . "333333") (:PROFILE--USE--BACKGROUND--IMAGE)
   (:DEFAULT--PROFILE) (:DEFAULT--PROFILE--IMAGE) (:FOLLOWING)
   (:FOLLOW--REQUEST--SENT) (:NOTIFICATIONS))
  (:GEO) (:COORDINATES) (:PLACE) (:CONTRIBUTORS) (:RETWEET--COUNT . 0)
  (:FAVORITE--COUNT . 0)
  (:ENTITIES (:HASHTAGS) (:SYMBOLS) (:URLS) (:USER--MENTIONS)) (:FAVORITED)
  (:RETWEETED) (:LANG . "ja"))

...

)

とJSON形式をパースしたツイートのリストが手に入る。JSONデータを取得できたので、あとはTweetのクラスを定義したり、HTMLの形にゴリゴリ整形して表示させたりと色々なことができそうである。蛇足になるが一応載せておく

;;; ここからcl-whoを使ってHTMLを書くのでパッケージを再定義しておく
(ql:quickload :cl-who)

(defpackage :clack-oauth-test
  (:use :common-lisp :clack :clack.middleware.oauth :cl-who :anaphora :alexandria))

(defmacro html (&body body)
  (let ((s (gensym)))
    `(with-html-output-to-string (,s)
       ,@body)))

(defmacro defclass$ (class-name superclass-list &body body)
  "Simplified definition of classes which similar to definition of structure.
 [Example]
  (defclass$ agent (superclass1 superclass2)
    currency
    (position-upper-bound 1)) ; specify init value
=> #<STANDARD-CLASS AGENT>"
  `(defclass ,class-name (,@superclass-list)
     ,(mapcar (lambda (slot)
		(let* ((slot-symbol (if (listp slot) (car slot) slot))
		       (slot-name (symbol-name slot-symbol))
		       (slot-initval (if (listp slot) (cadr slot) nil)))
		  (list slot-symbol
			:accessor (intern (concatenate 'string slot-name "-OF"))
			:initarg (intern slot-name :KEYWORD)
			:initform slot-initval)))
	      body)))

(defclass$ tweet ()
  json-data id retweet-user-name retweet-user-screen-name timestamp text
  user-name user-screen-name profile-image-url
  entities entities-urls entities-hashtags entities-user-mentions
  state-list)

(defun parse-twitter-timestring (timestring)
  (let* ((three-char-month-list
	  '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
	 (year (subseq timestring 26 30))
	 (month (format nil "~2,'0D"
			(1+ (position (subseq timestring 4 7) three-char-month-list :test #'string=))))
	 (day (subseq timestring 8 10))
	 (hour-min-sec (subseq timestring 11 19))
	 (timezone (subseq timestring 20 25)))
    (local-time:parse-timestring (concatenate 'string year "-" month "-" day "T" hour-min-sec timezone))))

(defun make-tweet (json-tweet)
  (let ((retweeted-status (cdr (assoc :RETWEETED--STATUS json-tweet)))
	(user (cdr (assoc :USER json-tweet))))
    (if retweeted-status
	;; retweet
	(let ((retweeted-user (cdr (assoc :USER retweeted-status))))
	  (make-instance
	   'tweet
	   :json-data json-tweet
	   :id (cdr (assoc :ID json-tweet))
	   :retweet-user-name (cdr (assoc :NAME user))
	   :retweet-user-screen-name (cdr (assoc :SCREEN--NAME user))
	   :timestamp (parse-twitter-timestring (cdr (assoc :CREATED--AT retweeted-status)))
	   :text (cdr (assoc :TEXT retweeted-status))
	   :user-name (cdr (assoc :NAME retweeted-user))
	   :user-screen-name (cdr (assoc :SCREEN--NAME retweeted-user))
	   :profile-image-url (cdr (assoc :PROFILE--IMAGE--URL retweeted-user))
	   :entities (sort (apply #'append (mapcar #'cdr (cdr (assoc :entities retweeted-status))))
			   (lambda (a b)
			     (> (cadr (assoc :indices a))
				(cadr (assoc :indices b)))))))
	;; normal
	(make-instance
	 'tweet
	 :json-data json-tweet
	 :id (cdr (assoc :ID json-tweet))
	 :retweet-user-name nil
	 :retweet-user-screen-name nil
	 :timestamp (parse-twitter-timestring (cdr (assoc :CREATED--AT json-tweet)))
	 :text (cdr (assoc :TEXT json-tweet))
	 :user-name (cdr (assoc :NAME user))
	 :user-screen-name (cdr (assoc :SCREEN--NAME user))
	 :profile-image-url (cdr (assoc :PROFILE--IMAGE--URL user))
	 :entities (sort (apply #'append (mapcar #'cdr (cdr (assoc :entities json-tweet))))
			 (lambda (a b)
			   (> (cadr (assoc :indices a))
			      (cadr (assoc :indices b)))))))))

;; URLやID、ハッシュタグにリンクを付けたものを返す
(defun add-link-to-text (text entities)
  (reduce (lambda (text alist)
	    (let ((indices      (aif (assoc :indices alist)       (cdr it)))
		  (url          (aif (assoc :url alist)           (cdr it)))
		  (display-url  (aif (assoc :display--url alist)  (cdr it)))
		  (hashtag-text (aif (assoc :text alist)          (cdr it)))
		  (screen-name  (aif (assoc :screen--name alist)  (cdr it))))
	      (cond (url
		     (concatenate 'string (subseq text 0 (car indices))
				"<a href=\"" url "\" target=\"_blank\"\">" display-url "</a>"
				(subseq text (cadr indices))))
		    (hashtag-text
		     (concatenate 'string (subseq text 0 (car indices))
				"<a href=\"https://twitter.com/search?q=" (hunchentoot:url-encode hashtag-text) "&src=hash\" target=\"_blank\"\">#"
				hashtag-text "</a>"
				(subseq text (cadr indices))))
		    (screen-name
		     (concatenate 'string (subseq text 0 (car indices))
				"<a href=\"https://twitter.com/" screen-name "\" target=\"_blank\"\">@"
				screen-name "</a>"
				(subseq text (cadr indices))))
		    (t text))))
	  entities
	  :initial-value text))

(defun render-tweet (tweet)
  (html
    (:div :class "tweet-body"
	  (:div :class "tweet-icon"
		(:img :src (profile-image-url-of tweet) :align "left"))
	  (:div :class "tweet-id"
		(:a :href (concatenate 'string "https://twitter.com/" (user-screen-name-of tweet))
		    :target "_blank"
		    (:strong (str (user-name-of tweet))))
		(str (concatenate 'string " @" (user-screen-name-of tweet))))		
	  (aif (retweet-user-name-of tweet)
	    (htm (:a :class "retweeted-by"
		     :href (concatenate 'string "https://twitter.com/" (retweet-user-screen-name-of tweet))
		     :target "_blank"
		     (str (concatenate 'string " retweeted by " it)))))
	  (:div :class "tweet-text"
		(str (add-link-to-text (text-of tweet) (entities-of tweet))))
	  (:a :class "tweet-timestamp"
	      :href
	      (concatenate 'string "https://twitter.com/" (user-screen-name-of tweet)
			   "/status/" (format nil "~A" (id-of tweet)))
	      :target "_blank"
	      (str (local-time:format-timestring nil (timestamp-of tweet)
						 :format local-time:+rfc-1123-format+)))
	  ;; (:p (str (local-time:format-rfc1123-timestring nil (local-time:now)))) ; debug
	  )))

(defparameter stylesheet
".tweet-body{
    border: 1px solid #333;
    border-radius: 10px;
    color: #333333;
    width: 525px;
    padding: 0.4em;
    float: left;
    margin: 3px 0px 0px 0px;
}

.tweet-id{
    width: 265px;
    float: left;
}

.retweeted-by{
    color: #888888;
    font-size:84%;
    width: 210px;
    float: left;
    text-align: right;
}

.tweet-text{
    color: #333333;
    width: 475px;
    float: left;
}

.tweet-timestamp{
    color: #888888;
    font-size:84%;
    width: 525px;
    float: left;
    text-align: right;
}")

(defun callback (request access-token)
  (setf *request* request)
  (setf *access-token* access-token)
  `(200
    (:content-type "text/html")
    (,(html
	(:html
	  (:head (:style :type "text/css" (str stylesheet)))
	  (:body
	   (:p "Authorized!")
	   (str (reduce (lambda (t1 t2)
			  (concatenate 'string t1 t2))
			(mapcar (lambda (json-tweet)
				  (render-tweet (make-tweet json-tweet)))
				(home-timeline access-token))))))))))