haskell-servant の利用例とちょっとだけ仕組みの調査

はじめに

Haskell には大小様々な Web フレームワークがあります．(yesod, scotty, spock, apiary, rest, 等々)

API サーバを作りたいときは scotty を利用することが多かったのですが，つい最近 haskell-servant というパッケージ群を知りました．

小さな API サーバを書きたいときに便利そうだなと思い，使いつつ軽くコードを読んでみました*1．

環境

• GHC 7.8.3 (64bit)

haskell-servant

• 公式ページ

型を用いて API 仕様を定義するタイプのフレームワークで，クライアントコードやドキュメントも生成してくれます． API の型とそれに対応するハンドラを組み合わせることで WAI アプリケーションとして動作します．

現在の形になったのはつい最近なんでしょうか？ → Rethinking webservice and APIs in Haskell: servant 0.2

試作: メモアプリ用 API サーバ

• examples/haskell-servant-webapp

以下のような API を定義しています．

type MemoAPI =
         "memos"                     :> Get [Memo]
    :<|> "memos" :> ReqBody ReqMemo  :> Post Memo
    :<|> "memos" :> Capture "id" Int :> Delete

:> が / みたいなもので，:<|> が API の結合だそうです． route を構成するパスやパラメータ名もリテラルとして型に埋め込めます．

戻り値の型は ToJSON，ReqBody に指定する型は FromJSON，Capture に指定する型は FromText をそれぞれ実装する必要があります．

例えば FromText であれば以下のようになります．

-- 例: 数値の offset を TimeZone として解釈させたいとき
import Data.Time
import Data.Text.Read  (decimal)

instance FromText TimeZone where
    fromText t =
        case decimal t of
            Right (h, _) -> Just $ hoursToTimeZone h
            _            -> Nothing

また，ドキュメント生成時にパラメータの説明やサンプルデータが必要になるため，それぞれ ToCapture，ToSample のインスタンスを実装します．

instance ToCapture (Capture "id" Int) where
    toCapture _ = DocCapture "id" "memo id"

instance ToSample Memo where
    toSample = Just sampleMemo

instance ToSample [Memo] where
    toSample = Just [sampleMemo]

sampleMemo :: Memo
sampleMemo = Memo
    { id = 5
    , text = "Try haskell-servant."
    , createdAt = ZonedTime (LocalTime (fromGregorian 2014 12 31) midday) (hoursToTimeZone 9)
    }

仕様変更したときに何か不足していればコンパイルエラーになるため「実装とドキュメントがずれてしまう」といったことは減らせそうです． ただ今のところデフォルトで出力可能な形式は markdown だけのようで，出力形式を変えたい場合は自前で API -> String を実装する必要があります．

仕組みを知る上で前提となる知識

(※ご存知の方は読み飛ばしてください)

Type operators

https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/data-type-extensions.html

オペレータシンボルを型コンストラクタとして扱うための拡張です．-XTypeOperators で有効になります． 型やクラスの宣言に利用されるオペレータを除けば，プレフィックスに : がなくても良い？みたいです．

servant では :> や :<|> がこれに相当します．

Type-Level Literals

https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/type-level-literals.html

数値や文字列を型レベルの定数として扱うことができるようです． -XDataKinds で有効になります (DataKinds 自体は，型を kind に，値コンストラクタを型コンストラクタに持ち上げる拡張)．

以下は上記ページの例そのままですが，Label "x" が型として機能しています．

-- 引用元: https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/type-level-literals.html

data Label (l :: Symbol) = Get      -- String は Symbol kind

class Has a l b | a l -> b where
  from :: a -> Label l -> b

data Point = Point Int Int deriving Show

instance Has Point "x" Int where from (Point x _) _ = x
instance Has Point "y" Int where from (Point _ y) _ = y

example = from (Point 1 2) (Get :: Label "x")

もちろん Get :: Label "y" とすれば example は 2 を返します．

servant では API のルーティングパスを表現するところで利用されています．

Kind polymorphism

https://downloads.haskell.org/~ghc/7.8.3/docs/html/users_guide/kind-polymorphism.html

kind が多相的に扱えるようになります．何て呼ぶんでしょうか？多相カインド？ -XPolyKinds で有効になります．

kind が明示されていない部分は * ではなく kind 変数として推論されるようになるみたいです．

data T m a = MkT (m a)

↓GHCi

*Test> :kind T
T :: (* -> *) -> * -> *

*Test> :set -XPolyKinds
*Test> :kind T
T :: (k -> *) -> k -> *     -- m の kind が * -> * から k -> * (変数あり) に変わった

Proxy

base の Data.Proxy に定義された，型情報を持つだけの data です．

data Proxy t = Proxy

↓GHCi

Prelude Data.Proxy> :kind Proxy
Proxy :: k -> *

kind が多相的になっているため，* や Nat，Symbol といった kind に関係なく様々な型を持つことができます．

servant の :> はいろいろな kind を持った型をとるため，Proxy を使って定義されています．

-- 引用元: https://hackage.haskell.org/package/servant-0.2.1/docs/src/Servant-API-Sub.html#:>
data (path :: k) :> a = Proxy path :> a
infixr 9 :>

ちょっとだけ内部に潜る

Application の作成

serve に渡した p :: Proxy layout と server :: Server layout から，HasServer クラスの route 関数 (の実装) が RoutingApplication を作成します．

RoutingApplication は WAI の Application が少し変更されたもので，servant の RoutingResult を扱うようになっているため toApplication 関数でこれを変換して最終的な Application にしています．

-- 引用元: https://hackage.haskell.org/package/wai-3.0.2/docs/src/Network-Wai.html#Application
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server.html#serve
serve :: HasServer layout => Proxy layout -> Server layout -> Application
serve p server = toApplication (route p server)

ルーティング処理

実際にルーティングを行っている route 関数は Visitor パターンのような実装になっています．HasServer の instance 実装でパターンマッチしているようなイメージ？であっているでしょうか．

パスやパラメータ/戻り値の型は Proxy layout から決定され，Server layout もその型に従うように要求されます．

-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#HasServer

class HasServer layout where
  type Server layout :: *
  route :: Proxy layout -> Server layout -> RoutingApplication

API を結合する :<|> の場合，以下のように分離された a :: Server a，b :: Server b をそれぞれまた route に引き渡すような実装になっています． a が失敗した場合に b が実行されるようになっていることもわかります．

-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#instance%20HasServer%20(a%20:<|>%20b)

instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
  type Server (a :<|> b) = Server a :<|> Server b   -- ここは type operator
  route Proxy (a :<|> b) request respond =          -- ここは constructor
    route pa a request $ \ mResponse ->
      if isMismatch mResponse
        then route pb b request $ \mResponse' -> respond (mResponse <> mResponse')
        else respond mResponse

    where pa = Proxy :: Proxy a
          pb = Proxy :: Proxy b

途中の path をたどっていく部分は，WAI の Request から取得したリクエストパスと，シンボルとして型に埋め込まれた文字列 path とを比較し，一致すればさらに進み，一致しなければ失敗 (NotFound) としてレスポンスを返していることがわかります．

-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#instance%20HasServer%20(path%20:>%20sublayout)

instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
  type Server (path :> sublayout) = Server sublayout
  route Proxy subserver request respond = case pathInfo request of
    (first : rest)
      | first == cs (symbolVal proxyPath)    -- ここで文字列を取り出して比較
      -> route (Proxy :: Proxy sublayout) subserver request{
           pathInfo = rest
         } respond
    _ -> respond $ failWith NotFound

    where proxyPath = Proxy :: Proxy path

なお，symbolVal は型レベルリテラル (Symbol) を文字列として取り出す関数です．

symbolVal (Proxy :: Proxy "hoge") == "hoge"     -- True

パラメータがある場合 (例えばサンプルコードの Capture "id" Int) は，captured で Text から a 型の値に変換され (ここで FromText のインスタンスが必要になる)，ハンドラの方 (route の引数である subserver :: Server layout) は a -> Server sublayout 型としてキャプチャしたパラメータの値に適用されています．

-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#instance%20HasServer%20(Capture%20capture%20a%20:>%20sublayout)

instance (KnownSymbol capture, FromText a, HasServer sublayout)
      => HasServer (Capture capture a :> sublayout) where

  type Server (Capture capture a :> sublayout) =
     a -> Server sublayout

  route Proxy subserver request respond = case pathInfo request of
    (first : rest)
      -> case captured captureProxy first of
           Nothing  -> respond $ failWith NotFound
           Just v   -> route (Proxy :: Proxy sublayout) (subserver v) request{ -- *ここ
                         pathInfo = rest
                       } respond
    _ -> respond $ failWith NotFound

    where captureProxy = Proxy :: Proxy (Capture capture a)

最終的に Proxy layout の末尾に指定された HTTP Method と戻り値の型の部分までたどり着き，ここで WAI のレスポンスが構築されます．

-- 引用元: https://hackage.haskell.org/package/servant-server-0.2.2/docs/src/Servant-Server-Internal.html#instance%20HasServer%20(Get%20result)

instance ToJSON result => HasServer (Get result) where
  type Server (Get result) = EitherT (Int, String) IO result
  route Proxy action request respond
    | null (pathInfo request) && requestMethod request == methodGet = do
        e <- runEitherT action    -- ここでハンドラの実行結果を取り出す
        respond . succeedWith $ case e of
          Right output ->
            responseLBS ok200 [("Content-Type", "application/json")] (encode output)
          Left (status, message) ->
            responseLBS (mkStatus status (cs message)) [] (cs message)
    | null (pathInfo request) && requestMethod request /= methodGet =
        respond $ failWith WrongMethod
    | otherwise = respond $ failWith NotFound

EitherT の Left は失敗したときのステータスコードとメッセージの組，Right は成功したときの戻り値をそれぞれ表しています．

  type Server (Get result) = EitherT (Int, String) IO result

おわりに

あまり深追いはしていませんが，ざっと仕組みは追えたと思います．

ルーティングの部分を型で守りたいと思い apiary を試していましたが，servant も興味深い選択肢の一つだと思いました．

*1:加えて，読み進める過程で自身の知識不足がよく分かりましたので，いろいろ書き残そうと思いました．