[haskell][yesod] YesodにおけるRESTfulなJSON API実装チュートリアル

HaskellのwebフレームワークであるYesodにおいて、RESTful APIを実装する手順を紹介します。Haskell上のデータ構造をJSONテキストに変換する、逆に、JSONテキストをパースしてHaskell上のデータ構造を生成する、といった処理が非常に簡単に実現できます。加えて、コードを書かなくてもバックエンドのDBとのORマッピングが可能になっており、効率的に開発することができます。
ここで紹介しているコードはgithubにコミットしています。

準備：

• json-sampleというプロジェクト名でYesodのscaffolding siteをセットアップする
• 空のプロジェクト生成

% stack new json-sample yesod-sqlite --system-ghc

"--system-ghc"は省略可能。インストール済みのghcを使うことを指示しています。
• 依存ツールをビルド

% stack build yesod-bin cabal-install --no-install-ghc

"--no-install-ghc"は省略可。ghcのインストールを抑制するオプションです。
• scaffolding siteをビルド

% stack build

• scaffolding siteの動作確認

% stack exec -- yesod devel

ブラウザで http://localhost:3000/ にアクセスできることを確認

このチュートリアルで作るもの：シンプルな掲示板

• 以下のREST APIを提供するシンプルな掲示板を作ってみます。
• POST http://localhost:3000/posts
• 記事を1件ポストする。
• GET http://localhost:3000/posts
• 投稿済みの記事一覧を返す。シンプルなGET。
• GET http://localhost:3000/posts/sender
• "sender"によって投稿された記事一覧を検索して返す。
• バックエンドDBにはsqliteを利用し、postされた記事は以下のスキーマで生成された"post"テーブルに格納します。

CREATE TABLE "post"(
  "id" INTEGER PRIMARY KEY,
  "title" VARCHAR NOT NULL,
  "content" VARCHAR NOT NULL,
  "sender" VARCHAR NOT NULL);

POSTの実装：

• DBのmodelの定義
• mode/configファイルを開き、以下の記述を追加します。"Post"の直後に記載されている"json"がキモです。この記述によりToJson/FromJson関数が自動生成されます。

Post json
    title Text
    content Text
    sender Text

• Handerの追加
• 以下の通りyesod add-handlerコマンドを実行しHandlerを追加します。

% stack exec -- yesod add-handler
Name of route (without trailing R): Posts
Enter route pattern (ex: /entry/#EntryId): /posts
Enter space-separated list of methods (ex: GET POST): GET POST

後で実装するGETもあわせて追加しておきます。
• handler/Post.hsのpostPostRを実装する
• handler/Post.hsのpostPostR関数を以下のように修正します。関数の型がHandler HtmlからHandler ()に変更されている点に注意してください。

{--
postPostsR :: Handler Html
postPostsR = error "Not yet implemented: postPostsR"
--}

postPostsR :: Handler ()
postPostsR = do
    post <- requireJsonBody :: Handler Post
    _    <- runDB $ insert post
    sendResponseStatus status201 ("CREATED" :: Text)

• add-handlerのバグで発生するjson-sample.cabalファイルの不備を修正します。

library
    hs-source-dirs: ., app
    exposed-modules: Application
                     Foundation
                     Import
                     Import.NoFoundation
                     Model
                     Settings
                     Settings.StaticFiles
                     Handler.Common
                     Handler.Home
                     Handler.Comment
                     Handler.Posts

上記の通り、json-sample.cabalファイルの"exposed-modules"にHandler.Postsを手動で追記します。
• 動作確認
• curlコマンドで記事をポストしてみましょう。

% curl -v -H "Accept: application/json" -H "Content-type: application/json" -X POST -d '{"title" : "this is a title.", "content" : "this is a content.", "sender" : "kuro"}' --noproxy "*" http://localhost:3000/posts
*   Trying 127.0.0.1...
* Connected to localhost (127.0.0.1) port 3000 (#0)
> POST /posts HTTP/1.1
> Host: localhost:3000
> User-Agent: curl/7.47.0
> Accept: application/json
> Content-type: application/json
> Content-Length: 83
> 
* upload completely sent off: 83 out of 83 bytes
< HTTP/1.1 201 Created
< Transfer-Encoding: chunked
< Date: Sun, 28 Aug 2016 07:28:15 GMT
< Server: Warp/3.2.8
< Content-Type: text/plain; charset=utf-8
< Set-Cookie: _SESSION=O2DB2N/gbqZCdpbwyHihgoyK0Zfcj77lkv7J619gaHi8YZliO58oqpvWHIXKeGYZxZcDZpiVF1MJxWzoSaza0+pB5OrEMoG59xLuayySrnI2gUNMrGn+zRfeLkIUDEcCy7DjTNLaaYY=; Path=/; Expires=Sun, 28-Aug-2016 09:28:07 GMT; HttpOnly
< Vary: Accept, Accept-Language
< 
* Connection #0 to host localhost left intact

POSTに成功しHTTP/1.1 201 Createdが返されていればOKです。GETで記事を取得できるかどうかは次のフェーズで確認します。

シンプルなGETの実装：

• getPostR関数に実装を与える。こちらもgetPostRの型をHandler HtmlからHandler Valueに変更しています。

{--
getPostsR :: Handler Html
getPostsR = error "Not yet implemented: getPostsR"
--}

getPostsR :: Handler Value
getPostsR = do
    posts <- runDB $ selectList [] [] :: Handler [Entity Post]
    return $ object ["posts" .= posts]

"selectList [] []"により、persistentの機能を利用して、postテーブル内のすべての行を取得しています。
• 動作確認
• 以下のcurlコマンドでGETの動作を確認してみます

% curl -v -H "Accept: application/json" --noproxy "*" http://localhost:3000/posts
*   Trying 127.0.0.1...
* Connected to localhost (127.0.0.1) port 3000 (#0)
> GET /posts HTTP/1.1
> Host: localhost:3000
> User-Agent: curl/7.47.0
> Accept: application/json
> 
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 28 Aug 2016 07:37:02 GMT
< Server: Warp/3.2.8
< Content-Type: application/json; charset=utf-8
< Set-Cookie: _SESSION=8cq2RzyFQ4GmsHEgbAltpOFpOgys9zSm+xaE1LWFfv1WvgGpyKhmAkfRNRjqQf/clKN1y5BDgI36KedcIJWlIBFSz2teM8QSqMUon1BeLjzz8SOAT1Kdgi0JS5hfdlgu0TMMtHYXwIk=; Path=/; Expires=Sun, 28-Aug-2016 09:37:02 GMT; HttpOnly
< Vary: Accept, Accept-Language
< 
* Connection #0 to host localhost left intact
{"posts":[{"sender":"kuro","content":"this is a content.","id":1,"title":"this is a title."}]}

• レスポンスボディのJSONテキストを整形すると、以下のようになっています。

% curl -H "Accept: application/json" --noproxy "*" http://localhost:3000/posts | python -mjson.tool
{
   "posts" : [
      {
         "sender" : "kuro",
         "id" : 1,
         "content" : "this is a content.",
         "title" : "this is a title."
      }
   ]
}

フィルタ処理を伴うGET:

• Filterハンドラを新たに追加
• add-handlerで新たにFilter.hsを生成します。

% stack exec -- yesod add-handler
Name of route (without trailing R): Filter
Enter route pattern (ex: /entry/#EntryId): /posts/#Text
Enter space-separated list of methods (ex: GET POST): GET

• Filter.hsにgetFilterRを実装
• getFilterRを以下のように変更します。先ほどのgetPostRとほぼ同じですが、selectListで検索条件としてsenderを指定している点だけが異なります。

{--
getFilterR :: Text -> Handler Html
getFilterR sender = error "Not yet implemented: getFilterR"
--}

getFilterR :: Text -> Handler Value
getFilterR sender = do
    posts <- runDB $ selectList [PostSender ==. sender] [] :: Handler [Entity Post]
    return $ object ["posts" .= posts]

persistentのクエリ機能の詳細については以前にまとめたブログエントリを参照を参照していただければ。
• 動作確認
• curlコマンドでsenderを指定して、一覧を取得してみましょう。正しく動いているようです。

% curl --noproxy "*" http://localhost:3000/posts/kuro
{"posts":[{"sender":"kuro","content":"this is a content.","id":1,"title":"this is a title."},{"sender":"kuro","content":"this is a content.","id":2,"title":"this is a title."}]}

% curl --noproxy "*" http://localhost:3000/posts/hoge
{"posts":[{"sender":"hoge","content":"this is a content.","id":3,"title":"this is a title."}]}

% curl --noproxy "*" http://localhost:3000/posts/xxx
{"posts":[]}

参考：

• JSON API
• 本エントリで利用したコード（github）
• Writing JSON APIs with Yesod
• 実は persistent のスキーマ定義で、テーブル名の横に json と書くだけで ToJSON, FromJSON が定義されることが判明
• Yesod / persistent
• [haskell][persistent][sqlite] Haskellでデータベースを扱うには（Query編）
• [haskell][yesod] stack対応版Yesod tutorial