Haskell Servant 入門 (Strongly Typing)

Strongly typing in Haskell with Servant

強い型付けを使って servant server のアプリケーションを実装する方法を紹介します。
本記事のソースコードは以下のリポジトリにおいてあります。
http://github.com/algas/haskell-servant-cookbook

強い型付けによる効果

Servant ではクライアントおよびサーバで取り扱うデータに対して強い型付けが適用できます。
すなわち、扱うデータに対して型を適用するだけで制限をかけることができます。
ちなみに同じ Haskell の Web フレームワークでも Scotty などでは弱い型付け(型情報の欠落？)しか行われません(Scotty では Text 型として扱われる)。

強い型付けを導入した場合のメリットとデメリットを並べてみます。

メリット

• 型だけで値の validation ができます
  値が入力される箇所ごとに validation がされているかどうかをチェックする必要はなくなります。

デメリット

• 型の変換を実装するのに時間がかかります
  ただし、テストまで含めると多くの場合で時間を短縮できるはずです。

上記を読んだだけではその効果を理解するのが容易ではないと思うので、実装例を見てみましょう。

API

ユーザデータを扱う API を考えます。
ユーザ一覧を見る機能と新規ユーザを作成する機能を実現します。

Main.hs

type StrongAPI = "users" :> QueryParam "age" Teenage :> Get '[JSON] [User]
            :<|> "users" :> ReqBody '[JSON] User :> Post '[JSON] User

data User = User
    { name  :: Text
    , age   :: Teenage
    , email :: EmailAddress
    } deriving (Show, Eq, Generic, FromJSON, ToJSON)

上記の API で登場する User 型は name, age, email の値を持ちます。それぞれ Text, Teenage, EmailAddress の型を持ちます。
そのうち Teenage と EmailAddress が汎用ではない型です。
EmailAddress は hackage で公開されている email-validate ライブラリで定義されています。
Teenage は以下のように独自に定義した型です。

Teenage.hs

module Teenage
    ( Teenage
    , generateTeenage
    , teenage
    )where

newtype Teenage = Teenage { teenage :: Integer }
    deriving (Read, Show, Eq, Ord)

generateTeenage :: Integer -> Maybe Teenage
generateTeenage x
    | 12 < x && x < 20 = Just $ Teenage x
    | otherwise = Nothing

Teanage はその名のとおり、13から19までの整数値を持つ型です。想定外の値を代入されないためにコンストラクタは隠蔽してあります。

型変換

API で定義しているように QueryParam と ReqBody, Response (JSON) で Teenage, User (EmailAddress) を使っています。
型変換するためには、以下のインスタンス定義がそれぞれ必要です。

• QueryParam -> FromHttpApiData
• ReqBody -> FromJSON
• JSON Response -> ToJSON

Main.hs

instance FromHttpApiData Teenage where
    parseQueryParam x =
        let
            y = parseQueryParam x :: Either Text Integer
            in case y of
                Right r -> maybeToEither "Teenage" (generateTeenage r)
                Left l  -> Left "Teenage"

instance FromJSON Teenage where
    parseJSON (Number s) =
        case generateTeenage (coefficient s) of
            Just n -> return n
            _      -> typeMismatch "Teenage" (Number s)
    parseJSON m = typeMismatch "Teenage" m

instance ToJSON Teenage where
    toJSON = Number . flip scientific 0 . teenage

instance FromJSON EmailAddress where
    parseJSON (String s) =
        case emailAddress (encodeUtf8 s) of
            Just e -> return e
            _      -> typeMismatch "EmailAddress" (String s)
    parseJSON m = typeMismatch "EmailAddress" m

instance ToJSON EmailAddress where
    toJSON = String . decodeUtf8 . toByteString

User 自体の FromJSON, ToJSON instance は上記の data deriving で定義しているために、明示的に実装する必要はありません。

サーバ実装

以下はサーバ

Main.hs

userList :: [User]
userList =  [ User "John Smith" (fromJust (generateTeenage 18)) (fromJust (emailAddress "[e-mail]"))
            , User "Alice Jones" (fromJust (generateTeenage 14)) (fromJust (emailAddress "[e-mail]"))

strongApi :: Proxy StrongAPI
strongApi = Proxy

server :: Server StrongAPI
server = users :<|> newUser
    where
        users Nothing  = return userList
        users (Just a) = return [ u | u <- userList, age u == a ]
        newUser u = return u

app :: Application
app = serve strongApi server


main :: IO ()
main = do
    run 8080 app

注目してほしいところは、型変換の箇所での実装以外では validation を明示的に書いていないことです。
つまり、意図しない validation の漏れが存在しないので、潜在的な不具合を減らすことができます。
また、何度も同様の変換がコード内で登場する場合には実装するコード量の削減にもつながります。
本記事の例では API のエンドポイントの数や実装量が少ないために、普通に validation を実装した場合に比べて実装効率の向上をほとんど実感できないかもしれません。

動作確認

1. build
   stack build
2. serve
   stack exec strongly-typing
3. test

$ curl "http://localhost:8080/users"
[{"email":"[e-mail]","age":18,"name":"John Smith"},{"email":"[e-mail]","age":14,"name":"Alice Jones"}]

$ curl "http://localhost:8080/users?age=18"
[{"email":"[e-mail]","age":18,"name":"John Smith"}]

$ curl -H 'Accept: application/json' -H 'Content-type: application/json' -X POST -d '{"name":"hoge","age":19,"email":"[e-mail]"}' "http://localhost:8080/users"
{"email":"[e-mail]","age":19,"name":"hoge"}

$ curl -H 'Accept: application/json' -H 'Content-type: application/json' -X POST -d '{"name":"hoge","age":21,"email":"[e-mail]"}' "http://localhost:8080/users"
Error in $: expected Teenage, encountered Number

$ curl -H 'Accept: application/json' -H 'Content-type: application/json' -X POST -d '{"name":"hoge","age":13,"email":"hoge"}' "http://localhost:8080/users"
Error in $: expected EmailAddress, encountered String

前の3つのリクエストが成功、後の2つのリクエストが意図したとおりに失敗しています。
仕様通りのリクエストを送ると正しくレスポンスが返ってきます。
型による validation が正常に機能していて、範囲外の age や well-formed ではない email を与えるとエラー (400 Bad Request) が返ってきます。

参考文献

• 関数プログラミング実践入門 (大川徳之著) 第6章