Haskell
HaskellDay 9

【型レベルWeb DSL】 Servantの紹介

Note
2018-07-28: 最新の lts-12.2 で動くようにサンプルコードを修正しました。

Servant

Haskellは型の表現力がとても高い言語です。
型をうまく使えば意図しないプログラムがコンパイルできないように設計することが出来ます。ServantはWebアプリがどのように振る舞うかを型で設計するためのDSLです。APIと対応した型を作ることで間違いが少なくなるだけでなく様々なボイラープレートを型から生成することも出来ます。特殊な外部ファイル等は必要無く全てHaskellの文法で完結します。まさに型の表現力が高いHaskellでしか作れないライブラリです。

Servantの特徴としてチュートリアルでは以下の4つが挙げられています。

  • concision (簡潔である)
  • flexibility (汎用的・柔軟性がある)
  • separatation of concerns (関心の分離)
  • type safety (型安全である)

関心の分離というのはリクエストをパースしたりレスポンスをシリアライズするといったWebサーバー固有の処理とアプリケーション内部のロジックを分離することです。例えば一般的なWAFであればリクエストで送られてきたbodyをパースして目当てのデータを作る必要があったりヘッダーに含まれるデータを検索して取ってきたりデータをシリアライズしてレスポンスに詰めてやったりする必要がありますが、Servantではそういった冗長な部分をServantが担当してくれるので全く書く必要がありません。

なぜそれが可能なのかというと型安全であることに関係しています。servantはそのAPIがどういうものであるのかを型によって記述します。ルーティングはどうなっているのか、どういうパラメータが送られてくるのか、どういうレスポンスが返されるのか等をすべて型で表現します。例えば

         -- GET /todo/all
type API = "todo" :> "all" :> Get '[JSON] [Todo]

のように書きます。型をなんとなく読んでみるととこのAPIは/todo/allにGETでアクセスするとJSON形式でTodoのリストが返ってくるという風に見えます(慣れが必要かもしれません :stuck_out_tongue_closed_eyes: )。APIの仕様を型というコンパイラが理解できる形式で表現できるので、これを使ってコンパイラが様々なボイラープレートを生成することが出来るのです。

Servantが簡単にしてくれるのはサーバーの実装だけでなくモックやクライアントといったものもAPIの型から作ることが出来ます。ドキュメントを実際に使われているAPIの型から生成するようにすればwikiのように腐っていくことはありません。

本記事で紹介するコードは全てGitHubに公開しています。例の最後に動かし方を載せますが事前にダウンロードしておくとスムーズでしょう

$ git clone git@github.com:lotz84/ac2015-servant-example.git
$ cd ac2015-servant-example
$ stack build

Haskell環境のインストールやstackの導入は以下のリンクを参考にしてください。

単純な例

とにかく最初は簡単な例で具体的な使い方を見ていきましょう。
先程の例で出した/todo/allにGETでアクセスするとJSON形式でTodoのリストが返ってくるWebアプリを考えます。

APIをServantで書くと

         -- GET /todo/:id
type API = "todo" :> "all" :> Get '[JSON] [Todo]

api :: Proxy API
api = Proxy

このように型演算子:>で型レベルの文字列(Symbol)を繋げてURLを表現して最後に返却する値の型を指定します。この型がAPIの挙動を全て表現しています。
他の関数からこのAPIを扱いやすいようにapiというProxyを宣言しています。これはServantの唯一のボイラープレートです。

Todoのデータ構造は

data Todo = Todo
  { todoId :: Int
  , title  :: String
  , done   :: Bool
  } deriving (Generic, ToJSON)

このようなものにしましょう。JSONで返却するのでToJSONのインスタンスにしています。

実はこの様に型を定義した時点でモックサーバーを立てることが出来ます。正確にはあとひとつ、ランダムな値を生成するためにTodoQuickCheckArbitraryのインスタンスにする必要があります。

instance Arbitrary Todo where
  arbitrary = Todo <$> arbitrary <*> arbitrary <*> arbitrary

あとはsevant-mockmock関数を使って

main :: IO ()
main = do
  putStrLn "Listening on port 8080"
  Warp.run 8080 $ serve api (mock api Proxy)

このようにすればモックサーバーの完成です。serveservant-serverに含まれる関数でwaiApplicationを返します。なのでwarpを使ってサーバーを建てます。これを実行して http://localhost/todo/all にアクセスすればランダムなTodoのリストが返って来るはずです。

simple/Main_mock_version.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeOperators #-}

import Data.Aeson
import GHC.Generics
import qualified Network.Wai.Handler.Warp as Warp
import Servant
import Servant.Mock
import Test.QuickCheck

-- | Servant によるAPIの型
type API = "todo" :> "all" :> Get '[JSON] [Todo]

-- | 唯一のボイラープレート
api :: Proxy API
api = Proxy

-- | Todoに関する情報
data Todo = Todo
  { todoId :: Int
  , title  :: String
  , done   :: Bool
  } deriving (Generic, ToJSON)

instance Arbitrary Todo where
  arbitrary = Todo <$> arbitrary <*> arbitrary <*> arbitrary

main :: IO ()
main = do
  putStrLn "Listening on port 8080"
  Warp.run 8080 $ serve api (mock api Proxy)

すこし寄り道しましたがあらためてサーバーを実装していきましょう。返却するTodoのリストは以下の様なものにします

todoList :: [Todo]
todoList =
  [ Todo 1 "アドベントカレンダーを書く" True
  , Todo 2 "Haskellで仕事する" False
  , Todo 3 "寝る" False
  ]

いよいよサーバーの実装です!

server :: Server API
server = pure todoList

これだけです!ServerAPIの形から自動的にserveに渡すべき関数の型を決定してくれます。今回作るのは/todo/allにアクセスするとTodoのリストが返るだけの単純なものなのでサーバーの実装は返すTodoのリストを指定するだけで十分で、具体的にはEitherT ServantErr IO [Todo]となります。

simple/Main.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeOperators #-}

import Data.Aeson
import GHC.Generics
import qualified Network.Wai.Handler.Warp as Warp
import Servant

-- | Servant によるAPIの型
type API = "todo" :> "all" :> Get '[JSON] [Todo]

-- | 唯一のボイラープレート
api :: Proxy API
api = Proxy

-- | Todoに関する情報
data Todo = Todo
  { todoId :: Int
  , title  :: String
  , done   :: Bool
  } deriving (Generic, ToJSON)

-- | Todoリスト
todoList :: [Todo]
todoList =
  [ Todo 1 "アドベントカレンダーを書く" True
  , Todo 2 "Haskellで仕事する" False
  , Todo 3 "寝る" False
  ]

-- | サーバーの実装
server :: Server API
server = pure todoList

main :: IO ()
main = do
  putStrLn "Listening on port 8080"
  Warp.run 8080 $ serve api server

試しに実行してみましょう。

$ stack exec simple
Listening on port 8080

サーバーの起動を確認したら http://localhost:8080/todo/all にブラウザでアクセスしてみましょう。Todoの情報がJSON形式で返ってくるはずです。

[{"done":true,"todoId":1,"title":"アドベントカレンダーを書く"},{"done":false,"todoId":2,"title":"Haskellで仕事する"},{"done":false,"todoId":3,"title":"寝る"}]

TODO管理APIを作ってみる

前回の例で基本的な流れを説明しましたが次は複数のエンドポイントを持つもう少し大きなWebアプリを作ってみましょう

まずTodoに関するコードをライブラリにまとめてしまいます。内容は

  • Todoの定義
  • FromJSON, ToJSONのインスタンス
  • FromFormのインスタンス
  • CRUD(Create-Read-Update-Delete) の Servant DSL による定義

です。FromFormはフォームからのリクエストとして処理する時に必要になります。

todo/Todo.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}

module Todo (
  Todo(..)
, CRUD
, crud
) where

import Data.Aeson
import Data.Proxy
import qualified Data.Text as Text
import GHC.Generics
import Servant.API
import Web.FormUrlEncoded (FromForm(..), parseUnique)

data Todo = Todo
  { todoId :: Int
  , title  :: String
  , done   :: Bool
  } deriving (Generic, FromJSON, ToJSON)

instance FromForm Todo where
  fromForm form = Todo
              <$> parseUnique "todoId" form
              <*> parseUnique "title" form
              <*> parseUnique "done" form

type CRUD =    "todo" :> "all" :> Get '[JSON] [Todo]
          :<|> "todo" :> ReqBody '[JSON, FormUrlEncoded] Todo :> Post '[JSON] Todo
          :<|> "todo" :> Capture "id" Int :> ReqBody '[JSON, FormUrlEncoded] Todo :> Put '[JSON] ()
          :<|> "todo" :> Capture "id" Int :> Delete '[JSON] ()

crud :: Proxy CRUD
crud = Proxy

CRUDを定義する際に新しい形演算子:<|>が出てきましたがこれはエンドポイントを並列に定義するためのもので、今回の場合CRUDは以下の様なAPIを提供することになります。

GET    /todo/all
POST   /todo
PUT    /todo/:id
DELETE /todo/:id

この情報を使ってまずはこのAPIにアクセスするクライアントを作ってみましょう。servant-clientを使うとCRUDのProxyから以下の様に簡単にクライアントを作ることができます。

import Todo as Todo

getTodoAll   :: ClientM [Todo]
postTodo     :: Todo -> ClientM Todo
putTodoId    :: Int -> Todo -> ClientM ()
deleteTodoId :: Int -> ClientM ()

getTodoAll :<|> postTodo :<|> putTodoId :<|> deleteTodoId = client Todo.crud

clientが生成した関数を:<|>でパターンマッチをして取り出しています。順番に気をつける必要があるのは少しイケてないところかもしれません。生成したクライアントを利用してサーバーに一連の操作をする処理を書いてみましょう。

todo-client/Main.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Control.Monad (void)
import Control.Monad.IO.Class
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Servant.API
import Servant.Client
import Todo as Todo

getTodoAll   :: ClientM [Todo]
postTodo     :: Todo -> ClientM Todo
putTodoId    :: Int -> Todo -> ClientM ()
deleteTodoId :: Int -> ClientM ()

getTodoAll :<|> postTodo :<|> putTodoId :<|> deleteTodoId = client Todo.crud

todoList :: [Todo]
todoList =
    [ Todo 1 "アドベントカレンダーを書く" False
    , Todo 2 "Haskellで仕事する" False
    , Todo 3 "寝る" False
    ]

main :: IO ()
main = do
  manager <- newManager defaultManagerSettings
  let env = mkClientEnv manager $ BaseUrl Http "localhost" 8080 ""
  void . flip runClientM env $ do
    mapM_ postTodo todoList
    putTodoId 1 $ (todoList !! 0) {done = True}
    deleteTodoId 3
    list <- getTodoAll
    liftIO . mapM_ putStrLn $ map title list

実行するとhttp://localhost:8080/に対して

  • 複数のTodoを登録
  • idが1のTodoのdoneをTrueにする
  • idが3のTodoを削除する
  • 全てのTodoを取得する
  • Todoのタイトルを表示する

という処理が行われます。

サーバーを実装する前にWebページで使うためのjQueryライブラリを先に生成しておきましょう。使うのはservant-jsです。これはServantの型によるAPI定義からAngularJS, axios, jQueryなどのライブラリや生のJSでのクライアントコードを生成してくれる便利ライブラリです。

todo-jquery/Main.hs
import Servant.JQuery
import Todo as Todo

main :: IO ()
main = writeFile "todo-server/static/todo_crud.js" $ jsForAPI Todo.crud

これを実行するとJavaScriptのファイルが生成されます。

$ mkdir todo-server/static
$ stack exec todo-jquery

出来上がったファイルは以下のようになっています。

todo-server/static/todo_crud.js
var getTodoAll = function(onSuccess, onError)
{
  $.ajax(
    { url: '/todo/all'
    , success: onSuccess
    , error: onError
    , type: 'GET'
    });
}

var postTodo = function(body, onSuccess, onError)
{
  $.ajax(
    { url: '/todo'
    , success: onSuccess
    , data: JSON.stringify(body)
    , contentType: 'application/json'
    , error: onError
    , type: 'POST'
    });
}

var putTodoById = function(id, body, onSuccess, onError)
{
  $.ajax(
    { url: '/todo/' + encodeURIComponent(id) + ''
    , success: onSuccess
    , data: JSON.stringify(body)
    , contentType: 'application/json'
    , error: onError
    , type: 'PUT'
    });
}

var deleteTodoById = function(id, onSuccess, onError)
{
  $.ajax(
    { url: '/todo/' + encodeURIComponent(id) + ''
    , success: onSuccess
    , error: onError
    , type: 'DELETE'
    });
}

HaskellだけでなくJavaScriptのクライアントも作れるなんて便利ですね。僕は使ったことはありませんがRubyやKotlinクライアントを作ってくれるライブラリもあるらしいです(Lackey, servant-kotlin)。

いよいよサーバーを実装しましょう。サーバーではTodoのCRUDに加えてトップページからHTMLでTodoの一覧を表示できるようにしてみます。そのためCRUDに足りないAPIを足してやる必要があります。

import Todo as Todo

type API = Get '[HTML] ByteString
         :<|> "static" :> Raw
         :<|> Todo.CRUD

HTMLの型はservantには含まれておらず、blazelucidなど別のライブラリから提供されていますが、今回は自分で作ってみましょう。作り方はContent-Typeに紐付けるAcceptとレスポンスのシリアライズを行うMimeRenderを宣言するだけです。独自のコンテンツの型の作り方はServant.API.ContentTypesに詳しく書かれています。

import Network.HTTP.Media ((//), (/:))

data HTML

instance Accept HTML where
  contentType _ = "text" // "html" /: ("charset", "utf-8")

instance MimeRender HTML ByteString where
  mimeRender _ bs = bs

RawはServantに特に仕事をさせず、WAIで定義される任意のApplicationを挿入する際に使います。ここではservant-serverのserveDirectoryFileServerという関数を使って静的コンテンツを配信する予定です。末尾にある:<|> Todo.CRUDは見て分かる通りTodoで定義したCRUDのAPIをそのまま使いまわしています。APIを型で宣言したことでモジュール性がとても高くなっていてとても便利ですね!さらに多相型を使ってより抽象的なAPIを定義するテクニックが"Servant, persistent, and DSLs"では紹介されています。

テンプレートで使用する"index.html"の内容を載せておきます。

todo-server/templates/index.html
<!DOCTYPE html>
<html>
<head></head>
<body>
  <h1>Hello Servant!</h1>

  <table id="js-todo-list" border=1>
    <tr>
      <th> Todo </th>
      <th> Done </th>
    </tr>
  </table>

  <script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.4/jquery.min.js"></script>
  <script src="/static/todo_crud.js"></script>
  <script>
getTodoAll(function(todoList){
  var table = $("table#js-todo-list");
  todoList.forEach(function(todo){
    var title = $("<td />").text(todo.title);
    var checkbox = $("<input />").attr("type", "checkbox");
    if (todo.done) {
      checkbox.attr("checked", "checked");
    }
    var done  = $("<td />").append(checkbox);
    var tr = $("<tr />").append(title).append(done);
    table.append(tr);
  });
});
  </script>
</body>
</html>

JavaScriptのところで先ほど生成したjQueryクライアントのgetTodoAll関数を使っています。

それではサーバーを実装しましょう。本来ならMySQLなどのDBとも連携したいところですが今回は簡単のためIntMapをDBの代わりにして実装します。

server :: ByteString -> TVar (Int, IntMap Todo) -> Server API
server indexHtml db = index
       :<|> serveDirectoryFileServer "todo-server/static"
       :<|> getTodoAll
       :<|> postTodo
       :<|> putTodoId
       :<|> deleteTodoId
  where
    index              = pure indexHtml
    getTodoAll         = liftIO $ IntMap.elems . snd <$> atomically (readTVar db)
    postTodo todo      = liftIO . atomically $ do
                           (maxId, m) <- readTVar db
                           let newId = maxId + 1
                               newTodo = todo {todoId = newId}
                           writeTVar db (newId, IntMap.insert newId newTodo m)
                           pure newTodo
    putTodoId tid todo = liftIO . atomically . modifyTVar db $
                           \(maxId, m) -> (maxId, IntMap.insert tid todo m)
    deleteTodoId tid   = liftIO . atomically . modifyTVar db $
                           \(maxId, m) -> (maxId, IntMap.delete tid m)

肝心なのはWebサーバーであることを意識せず普通の関数として実装できるところです。今回は複数のエンドポイントがあるので、必要な引数をとってEitherT ServantError IO aを返す関数をそれぞれ書いたあとに:<|>で組み合わせます。以上でサーバーの実装は終わりです。

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

import Control.Concurrent.STM
import Control.Monad.IO.Class
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import GHC.Generics
import Network.HTTP.Media ((//), (/:))
import Servant
import qualified Network.Wai.Handler.Warp as Warp

import Todo as Todo

type API = Get '[HTML] ByteString
         :<|> "static" :> Raw
         :<|> Todo.CRUD

data HTML

instance Accept HTML where
  contentType _ = "text" // "html" /: ("charset", "utf-8")

instance MimeRender HTML ByteString where
  mimeRender _ bs = bs

api :: Proxy API
api = Proxy

server :: ByteString -> TVar (Int, IntMap Todo) -> Server API
server indexHtml db = index
       :<|> serveDirectoryFileServer "todo-server/static"
       :<|> getTodoAll
       :<|> postTodo
       :<|> putTodoId
       :<|> deleteTodoId
  where
    index              = pure indexHtml
    getTodoAll         = liftIO $ IntMap.elems . snd <$> atomically (readTVar db)
    postTodo todo      = liftIO . atomically $ do
                           (maxId, m) <- readTVar db
                           let newId = maxId + 1
                               newTodo = todo {todoId = newId}
                           writeTVar db (newId, IntMap.insert newId newTodo m)
                           pure newTodo
    putTodoId tid todo = liftIO . atomically . modifyTVar db $
                           \(maxId, m) -> (maxId, IntMap.insert tid todo m)
    deleteTodoId tid   = liftIO . atomically . modifyTVar db $
                           \(maxId, m) -> (maxId, IntMap.delete tid m)

main :: IO ()
main = do
  db <- atomically $ newTVar (0, IntMap.empty)
  indexHtml <- B.readFile "todo-server/templates/index.html"
  putStrLn "Listening on port 8080"
  Warp.run 8080 $ serve api (server indexHtml db)

実行してみましょう。まずはサーバーを建てます

$ stack exec todo-server
Listening on port 8080

サーバーが起動した状態で別のセッションからtodo-clientを実行します

$ stack exec todo-client
アドベントカレンダーを書く
Haskellで仕事する

ブラウザから http://localhost:8080 に接続すると

このように表示されていれば成功です!
少し本格的なWebアプリを作ってみましたがかなりのコードを書く手間が省けたのではないでしょうか。ここでは紹介しませんでしたがservant-docsservant-pandocを使えばドキュメントもServant DSLから生成することができます。

実世界のAPI

gogolというGoogleが提供する様々なサービスのAPIをServant DSLで実装したHaskellのパッケージ(群)があります。例えばNetwork.Google.YouTubeなどがわかりやすいでしょう。これがあれば他のServantライブラリと組み合わせることでモックやクライアントをすぐに作ることができます。これまでもfbigのように公開されてるAPIにアクセスするためのライブラリはいろいろありましたがそれぞれが独自の仕様で実装しているため学習に時間がかかるという欠点がありました。しかしgogolのようにServant DSLを提供するようにすれば全て同じServantなので扱うのがとても楽になります。

拙作ですがブロックチェーンに関する情報を返してくれるchainFlyer APIのクライアントを作っています。

実装の中心部分は以下のようになっているのですが、ここまで読み進めてくれた人ならどのようなAPIになっているのか型から何となく分かるのではないでしょうか

type ChainFlyerAPI =    BlockAPI
                   :<|> BlockHeightAPI
                   :<|> LatestBlockAPI
                   :<|> TransactionAPI
                   :<|> AddressAPI

                    -- /v1/block/:hash
type BlockAPI       = "v1" :> "block"   :> Capture "hash" String            :> Get '[JSON] Block
                    -- /v1/block/height/:height
type BlockHeightAPI = "v1" :> "block"   :> "height" :> Capture "height" Int :> Get '[JSON] Block
                    -- /v1/block/latest
type LatestBlockAPI = "v1" :> "block"   :> "latest"                         :> Get '[JSON] Block
                    -- /v1/tx/:hash
type TransactionAPI = "v1" :> "tx"      :> Capture "hash" String            :> Get '[JSON] Transaction
                    -- /v1/address/:address
type AddressAPI     = "v1" :> "address" :> Capture "address" String         :> Get '[JSON] Address

まとめ

Servantとそれを使った開発についてざっくり紹介してきました。やっぱりAPIという外壁を型に守られているのはとても安心感がありますね。Servantは同じ型からサーバーとクライアントを同時に作れるので例えばMicroservicesのようにアプリケーション単位でプロダクトが分かれてしまっても安全な開発が期待できそうです(k-bx/owlcloud)。しかしServantにも問題はいろいろあって型を間違えた時のエラーメッセージがまだまだ貧弱です。これは今後のGHCの開発に期待で、幸い型レベルプログラミングのサポートをより強化していくみたいなのでServantに取っては追い風になると思います。

Servant が Haskell のキラーアプリになればいいなぁ
それではよい型駆動開発(TDD)を!
Haskell Advent Calendar 9日目は @lotz でした