2016年8月28日日曜日

[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":[]}
      

参考: