PureScriptでAPIサーバー用のパッケージつくってみた

追記

本記事のパッケージは現在メンテされておりません。

サーバー向けパッケージは再実装されたものがこちらにあります。

Bucketchain

はじめに

https://github.com/Bucketchain PureScript Advent Calendar 2017 - Qiitaの10日目の記事です。

今年、APIサーバー用のパッケージを書いてみたので、それについて書きます。

結構前につくったものですが、Advent Calendar用のネタもそんなに持ってないので、これについて書くことにします。

なぜつくったのか

そもそもPureScriptでサーバー書こうという人がほとんどいないためか、サーバー用のパッケージはかなり少ないです。 (たぶん)有名なところで言うとhyperquickserveがありますが、それらも比較的最近つくられたものです。 あとは、node-httpなどの生のnodeのAPIをPureScriptで呼べるようにしたものくらいしかありませんでした。

そういうわけで、めんどくさそうだけどどうせ趣味でやってるだけだし勉強にはなるだろうということで私もつくってみることにしました。

ざっくりどんなものか

オレオレRPCです。具体的には以下のような制約になります。

  • POSTしか受け付けない
  • 呼び出したい処理はpathで指定する

RESTが広く浸透している世界ですが、そもそも「なるべくREST守ろう」という振る舞いが見られない人もいれば、REST頑張ろうとしている人間の頭の中に「各々にとっての正しいREST」があり、とりわけ「Resourceとは何なのか」ってところが人間によってブレている 、などの様々な事象が原因で「人間にRESTは結構難しいなー」という感想があります。

私はそのことについては「人間なのでしょうがない」とは思っていますが、そのことについてやりとりするのは正直飽きたし、どうでもよくなってしまいました。若者のREST疲れってやつです。(若いとは言ってない)

そのような背景がある上で、RPCでも私が当時よく見かけてたのは、pathは/のみで、呼び出したい処理はbodyで指定するという形でした。 たとえば、JSON-RPC 2.0 Specificationだったり、DynamoDB や Route53 などの AWS API が独特な仕様なので紹介 - Qiitaだったりでしょうか。 しかし、とりあえず自分が使えれば良いということと、内部実装上で少し手抜きをしたことで上記のような形となりました。これは

他人に受け入れられにくい制約なので、SSKDsなAPIにしか使いにくいと思われます。

以下がつくったパッケージです。

ここからは簡単に使い方を説明します。

レスポンスの型を用意する

import Control.Monad.Eff.Exception (message)
import Conveyor.Respondable (class Respondable)
import Simple.JSON (class WriteForeign, writeJSON)

data Result r
  = Success { status :: Int, body :: r }
  | Failure { status :: Int, messages :: Array String }

instance respondableResult :: WriteForeign r => Respondable (Result r) where
  contentType _ = "application/json"

  statusCode (Success s) = s.status
  statusCode (Failure f) = f.status

  encodeBody (Success s) = writeJSON s.body
  encodeBody (Failure f) = writeJSON f.messages

  systemError err = Failure { status: 500, messages: [ message err ] }

例えば、こんな感じです。Respondable型クラスのインスタンスにしましょう。SuccessのbodyはWriteForeignインスタンスであればオッケーな感じにしてみました。 実際には、必ず決まったJSONフォーマットにするシリアライザの仕組みを使ってencodeBodyを実装するといいと思います。

何かデータを返すだけの処理をつくってみる

import Conveyor.Handler (Handler)

newtype Book = Book { id :: Int, title :: String }
derive newtype instance writeForeignBook :: WriteForeign Book

getBooks :: forall e. Handler e (Result (Array Book))
getBooks = pure $ Success { status: 200, body: books }
  where
    books =
      [ Book { id: 1, title: "Book 1" }
      , Book { id: 2, title: "Book 2" }
      ]

本の配列を返します。BookエンコードできるようにWriteForeignインスタンスにしました。 各種pathに反応する処理は、このパッケージが提供するHandlerモナドを使って記述します。 Nodeがバックエンドなので非同期処理が満載になるはずなので、HandlerAffnewtypeにしました。

Bodyを受け取る処理をつくってみる

import Conveyor.Body (Body(..))
import Conveyor.Readable (class Readable)
import Simple.JSON (class ReadForeign, class WriteForeign, readJSON', writeJSON)

derive newtype instance readForeignBook :: ReadForeign Book

instance readableBook :: Readable Book where
  readBody = readJSON'

createBook :: forall e. Body Book -> Handler e (Result Book)
createBook (Body book) = pure $ Success { status: 201, body: book }

さきほど定義したBook型をrequest bodyとして受け取れるようにしてみました。Readable型クラスのインスタンスにし、関数の引数をBody BookとすればOKです。 ここの例では、readBodyの実装はSimple-JSONに任せてしまいました。

エラーが起こる処理をつくってみる

import Control.Monad.Eff.Exception (error, message)
import Control.Monad.Error.Class (throwError)

alwaysError :: forall e. Handler e (Result Book)
alwaysError = throwError $ error "Always Error !!!"

とりあえず意図的にthrowErrorを使ってエラーを起こしてみます。

サーバーを立ち上げてみる

import Prelude

import Control.Monad.Eff (Eff)
import Conveyor (run)
import Data.Maybe (Maybe(..))
import Node.HTTP (HTTP)

main :: Eff (http :: HTTP) Unit
main = run routes config
  where
    routes = { getBooks, createBook, alwaysError }
    config = { hostname: "0.0.0.0", port: 3000, backlog: Nothing }

run関数に適当なconfigとルーティングを渡します。ルーティングはさきほどつくったHandlerを単にRecordを渡せばOKです。

pulp runして、リクエストを送ると以下のように返ってきます。

POST localhost:3000/getBooks
=>
[
    {
        "title": "Book 1",
        "id": 1
    },
    {
        "title": "Book 2",
        "id": 2
    }
]

POST localhost:3000/createBook (適当なidとtitleをもったJSONをrequest bodyに渡す)
=>
{
    "title": "hoge",
    "id": 3
}

POST localhost:3000/alwaysError
=>
[
    "Always Error !!!"
]

値の共有をする

例えば、コネクションプールなど、サーバー起動時に生成したものを持ち回りたい、とかそういうお気持ちはあると思います。 そのための仕組みも一応用意してあります。

import Conveyor (runWithContext)
import Conveyor.Context (Context(..))
-- その他色々モジュールインポート

createBook :: forall e. Context Pool -> Body Book -> Handler (mysql :: MYSQL | e) (Result Book)
createBook (Context pool) (Body book) = -- 省略

main :: Eff (http :: HTTP, mysql :: MYSQL) Unit
main = do
  pool <- createPool
  runWithContext pool routes config
  where
    routes = { getBooks, createBook, alwaysError }
    config = { hostname: "0.0.0.0", port: 3000, backlog: Nothing }

このようにrunWithContextで好きな値を渡しておくと、関数側の引数でContextを指定すれば取り出せるようになっています。

もっと違う形で大域変数っぽいものを持ちたければ、Servableという型クラスを提供しているので、好きなモナドスタックのnewtypeをつくって、Servableインスタンスにすれば好きなようにできます。パッケージ側ではServableインスタンスこのくらいしか提供してないです :)

最後に

現在の実装はかなりquickserveをパクり(ry...参考にして作られているのですが、型クラスの使い方が結構勉強になりました :)