この記事は、スタートトゥデイ工務店 Advent Calendar 14日目の記事です。
wai（Haskell製のWebアプリケーション規格）に準拠し、warp（wai準拠のHaskell製Webサーバ）上で動作するWebアプリケーションの開発について紹介する。基本性能を際立たせるため、便利なフレームワークはあえて使用しない。
以前に非常に単純なサンプルを紹介した記事の続編となる。
今回は、本格的なWebアプリケーションに欠かせない、データベースとの連携を試してみた。
バックエンドにはMySQLを使用した。
ソースコードは https://github.com/mitsuji/wai-example-mysql にある。
1. サンプルアプリケーションの概要
下記のようなデータを扱うJSON-APIを実装した。
1件のコーディネートに対して、ジャンルが1つ、タグが複数(0..N)紐づくものとする。
オブジェクト図は下記のようになるだろう。
また、MySQLのCREATE文は下記のようになる。
CREATE TABLE genre (
genre_id INT NOT NULL AUTO_INCREMENT
,genre_title nvarchar(31) NOT NULL
,PRIMARY KEY (genre_id)
);
CREATE TABLE tag (
tag_id INT NOT NULL AUTO_INCREMENT
,tag_title nvarchar(31) NOT NULL
,PRIMARY KEY (tag_id)
);
CREATE TABLE look (
look_id INT NOT NULL AUTO_INCREMENT
,look_create_dt DATETIME NOT NULL
,look_update_dt DATETIME NOT NULL
,look_title nvarchar(31) NOT NULL
,look_description nvarchar(400) NOT NULL
,look_genre_id INT NOT NULL
,PRIMARY KEY (look_id)
,FOREIGN KEY (look_genre_id) REFERENCES genre (genre_id)
);
CREATE TABLE look_has_tag (
lht_look_id INT NOT NULL
,lht_tag_id INT NOT NULL
,PRIMARY KEY (lht_look_id,lht_tag_id)
,FOREIGN KEY (lht_look_id) REFERENCES look (look_id)
,FOREIGN KEY (lht_tag_id) REFERENCES tag (tag_id)
);
Haskellのデータ定義は下記のようになった。
data Genre = Genre GenreId Title [Look]
deriving (Eq)
data Tag = Tag TagId Title [Look]
deriving (Eq)
data Look = Look { lookId :: LookId
, lookCreateDt :: CreateDT
, lookUpdateDt :: UpdateDT
, lookTitle :: Title
, lookDescription :: Description
, lookGenre :: Genre'
, lookTags :: [Tag']
}
deriving (Eq)
newtype Genre' = Genre' Genre
deriving (Eq)
newtype Tag' = Tag' Tag
deriving (Eq)
2. 実装の方針
下記の方針で実装した。
* mysql-simpleを使用してMySQLのデータをHaskellのデータに変換する。
* aesonを使用してHaskellのデータをJSONに変換する。
* waiを使用してWebのインターフェースを提供する。
また、実用的なサンプルとするため、下記を盛りこんだ。
* トランザクション処理
* コネクションプール
* N対Nのリレーション
3. MySQLのデータをHaskellのデータに変換する。
mysql-simple では QueryResult という型クラスが用意されており、
任意のデータ型をこの型クラスのインスタンスにすることで、
MySQLに投げたクエリの結果をHaskellのデータに変換することができる。
下記のように convertResults を実装すればよい。
instance QueryResults Genre' where
convertResults [fa,fb] [va,vb] = Genre' $ Genre a b []
where !a = convert fa va
!b = convert fb vb
convertResults fs vs = convertError fs vs 2
上記を定義すると、下記のようにクエリを投げることができる。
結果は、関数の型からも分かるように Genre’ のリストとして取り出すことができる。
select_genre :: Connection -> IO [Genre']
select_genre conn =
query_ conn [r|
SELECT
genre_id
,genre_title
FROM genre
ORDER BY genre_id
|]
4. HaskellのデータをJSONに変換する。
aeson では ToJSON という型クラスが用意されており、
任意のデータ型をこの型クラスのインスタンスにすることで、
JSONへの変換を定義することができる。
下記のように toJSON を実装すればよい。
instance ToJSON Tag where
toJSON (Tag id t ls) =
object ["id" .= id
,"title" .= t
,"looks" .= ls
]
ソースコードのプロジェクトにREPLで入ると、
下記のようにaesonの動作を試すことができる。
*Main Data JSON MySQL> AE.encode $ Tag 100 "タグ100" []
"{\"looks\":[],\"id\":100,\"title\":\"\227\130\191\227\130\176\&100\"}"
5. コネクションプール
コネクションプールはresouce-poolというライブラリを使用して実装した。
このライブラリを使うと、DBの接続に限らず任意のリソースのプールを簡単に実装することができるようだ。
アプリケーション起動時に createPool でプールを作っておく。
createPool にはプールにリソースが確保されるときの処理、プールからリソースが開放されるときの処理と、プールのチューニングに関するいくつかのパラメータを設定する。
main :: IO ()
main = do
host:port:_ <- getArgs
cp <- createPool connect close 10 10 10
Warp.runSettings (
Warp.setHost (fromString host) $
Warp.setPort (read port) $
Warp.defaultSettings
) $ routerApp cp
where
connect :: IO MySQL.Connection
connect = MySQL.connect MySQL.defaultConnectInfo {
MySQL.connectHost = "localhost"
,MySQL.connectUser = "wai_exam_admin"
,MySQL.connectPassword = "abcd1234"
,MySQL.connectDatabase = "wai_exam"
}
close = MySQL.close
リソースプールの変数を引き渡しておけば、アプリケーションの任意の箇所で
withResource を使用して、プール内のリソースを使うことができる。
関数の呼び出しが深くなる場合は、リソースプールの共有に
Readerモナドなどを使うとよいだろう。
-- GET /v1/genre
(Right M.GET, [_,_]) -> do
bs <- AE.encode <$> (withResource cp $ \conn -> select_genre conn)
respond $ response200 bs
6. トランザクション処理
トランザクション処理は下記のように withTransaction を使うだけで実現されるようだ。
delete_look :: Connection -> LookId -> IO ()
delete_look conn id =
withTransaction conn $ do
execute conn
"DELETE FROM look_has_tag WHERE lht_look_id = ?" (Only id)
execute conn
"DELETE FROM look WHERE look_id = ?" (Only id)
return ()
7. ルーティング
URLのパスやHTTPメソッドの種類と、評価される関数をどのように紐づけるか。
wai が Text型のリストとしてURLのパスを提供してくれているので、
下記のようにパターンマッチを使ってルーティングを定義することができた。
フレームワークを使った場合ほどではないが、比較的簡潔にできた。
routerApp :: Pool MySQL.Connection -> Wai.Application
routerApp cp req respond = case Wai.pathInfo req of
"v1" : _ -> (v1App cp req respond) `catch` onException -- /v1{var}
_ -> staticApp req respond -- static html/js/css files
where
onException :: SomeException -> IO Wai.ResponseReceived
onException (SomeException e) = respond $ responseNG 5000 "unknown error"
-- onException (SomeException e) = respond $ responseNG 5000 $ displayException e
v1App :: Pool MySQL.Connection -> Wai.Application
v1App cp req respond = case Wai.pathInfo req of
_ : "genre" : _ -> genreApp cp req respond -- /v1/genre{var}
_ : "tag" : _ -> tagApp cp req respond -- /v1/tag{var}
_ : "look" : _ -> lookApp cp req respond -- /v1/look{var}
_ -> staticApp req respond -- static html/js/css files
HTTPメソッドも合わせてパターンマッチすれば、RESTっぽいことも簡単にできる。
genreApp :: Pool MySQL.Connection -> Wai.Application
genreApp cp req respond = case (M.parseMethod (Wai.requestMethod req), Wai.pathInfo req) of
-- POST /v1/genre
(Right M.POST, [_,_]) -> do
ps <- parseForm req
case lookupParam "title" ps of
Nothing -> respond $ responseNG 5101 "invalid title"
Just t -> do
bs <- AE.encode <$> (withResource cp $ \conn -> create_genre conn t)
respond $ response200 bs
-- DELETE /v1/genre/{id}
(Right M.DELETE, [_,_,id]) ->
case readMaybe (T.unpack id) of
Nothing -> respond $ responseNG 5102 "invalid id"
Just id -> do
withResource cp $ \conn -> delete_genre conn id
respond responseOK
8. SQLインジェクション防止機能
mysql-simple では SQLインジェクションを防止するため、query や query_ には
文字列のリテラルでSQL文を渡さなければならないようにしてあるようだ。
文字列結合を使ってSQL文を組み立てることができないため、
条件を任意で指定するSELECT文が少し作りにくかったが、
下記のようにすることで対応できた。
-- [TODO] sanitize param of LIKE phrase
select_look :: Connection -> Maybe Title -> Maybe Description -> Maybe GenreId -> Maybe TagId -> IO [Look]
select_look conn mt md mgid mtid = do
(ft,t) <- case mt of
Nothing -> return (1::Int,"%")
Just t -> return (0::Int,t)
(fd,d) <- case md of
Nothing -> return (1::Int,"%")
Just d -> return (0::Int,d)
(fgid,gid) <- case mgid of
Nothing -> return (1::Int,0)
Just gid -> return (0::Int,gid)
(ftid,tid) <- case mtid of
Nothing -> return (1::Int,0)
Just tid -> return (0::Int,tid)
ls <- query conn [r|
SELECT
look_id
,look_create_dt
,look_update_dt
,look_title
,look_description
,genre_id
,genre_title
FROM look
LEFT OUTER JOIN genre ON look_genre_id = genre_id
WHERE 1 = 1
AND (1=? OR look_title LIKE ?)
AND (1=? OR look_description LIKE ?)
AND (1=? OR look_genre_id = ?)
AND (1=? OR look_id IN
(SELECT lht_look_id FROM look_has_tag WHERE lht_tag_id =?))
ORDER BY look_id
|](ft,t,fd,d,fgid,gid,ftid,tid)
tags <- select_tag_for_looks conn ls
return $ merge_tags tags ls
9. まとめ
- mysql-simple などのライブラリを使えば DBのデータとHaskellのデータのマッピングは簡単。
- aeson を使えば Haskellのデータを JSON化するのは簡単。
- resource-pool を使えばコネクションプールの導入は簡単。
- mysql-simple のトランザクション処理は簡単確実。
- Webアプリケーションのパス/メソッドルーティングは単純なパターンマッチでもある程度可能。
- mysql-simple を使えば SQLインジェクションの危険性が低下。
10. 今後の課題
- mysql-simple 以外のDBライブラリもいろいろ試してみたい。
- 入力のバリデーションをもっとちゃんと実装してみたい。
- ファイルのアップロードも試してみたい。
- フロントエンドを実装して、実際に使ってみたい。