Help us understand the problem. What is going on with this article?

servant+persistentを利用する

More than 1 year has passed since last update.

Haskell Advent Calendar 2017 その3(!)、7日目の記事です。

HaskellでRESTサーバを書くライブラリはいくつかあるようですが、私が気に入っているのはservantです。対抗馬としてはScottyがあると思いますが、servantはより型に安全なそうなのと、APIのあり方が好きです。

servantはごく薄い機能しか提供していないので、本格的なRESTサーバに必須のDB連携を自分で書く必要があるのですが、巷にはこのサンプルが少ない気がしています。

また高レベルなDBアクセスフレームワークとしてはpersistentが有名だと思うのですが、servantと組み合わせた例が本家GitHubにあるにはあるのですが、persistentのバージョンが古くインターフェイスが変わっているのでコンパイルに通らなかったりするし、コネクションプーリングを使っていないので実戦的ではありません。

というわけで「一通り実戦で使えるであろう」というレベルのサンプルを作ったので紹介します。

なおこの記事内のコードで使っている主なライブラリとバージョンは以下の通りです。

  • servant-0.11
  • persistent-2.7.0
  • persistent-postgresql-2.6.1

全てのソースは次の場所にあります。
https://github.com/jabaraster/servant-persistent-sample/tree/7b9a086fc8cbd2742bed7758fd5618a1fe2252e9

まずは足回り

DBに関して、接続設定取得/コネクションプール作成/マイグレーション実施の3機能です。

module DataStore.Internal where

import Control.Monad.Logger         (runStdoutLoggingT)
import Control.Monad.Trans.Reader   (runReaderT)
import Control.Monad.Trans.Resource (runResourceT)
import Data.Yaml.Config             (loadYamlSettings
                                   , useEnv
                                    )
import Database.Persist.Postgresql  (PostgresConf(..)
                                   , withPostgresqlConn
                                   , createPostgresqlPool
                                    )
import Database.Persist.Sql         (Migration
                                   , ConnectionPool
                                   , runMigration
                                    )

-- loadYamlSettingsを使うと環境変数で設定を書き換えるのが楽になる
pgConf :: IO PostgresConf
pgConf = loadYamlSettings ["conf/database-setting.yml"] [] useEnv

pgPool :: IO ConnectionPool
pgPool = do
    conf <- pgConf
    runStdoutLoggingT $ createPostgresqlPool (pgConnStr conf) (pgPoolSize conf)

doMigration :: Migration -> IO ()
doMigration action = do
    conf <- pgConf
    runStdoutLoggingT $ runResourceT $ withPostgresqlConn (pgConnStr conf) $ runReaderT $ runMigration action

ここはservantと関係ないコードです。

一工夫したのは Data.Yaml.Config.loadYamlSettings 関数を使って設定値の読み込みを楽しているところ。この関数を使うとYAMLファイルから設定値を読み込めるのですが、環境変数やデフォルト値を簡単に設定できます。
次はYAMLファイルの例です。

user    : "_env:PG_USER:app"
password: "_env:PG_PASS:xxx"
host    : "_env:PG_HOST:localhost"
port    : "_env:PG_PORT:5432"
database: "_env:PG_DATABASE:app"
poolsize: "_env:PG_POOLSIZE:5"

ロギングについては、上記コードでは標準出力に出力しているのですが、もっと工夫の余地があると思います。

DBアクセス本体

ここもservantと関係ないです。DBアクセスする関数の引数でコネクションプールを受け取るようにするのがポイントです。

{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE QuasiQuotes                #-}

module DataStore where

import Control.Lens                 ((^.))
import Data.Text                    (Text)
import Database.Persist
import Database.Persist.Sql         (ConnectionPool
                                   , runSqlPool
                                    )
import Database.Persist.TH          (mkMigrate
                                   , mkPersist
                                   , persistLowerCase
                                   , share
                                   , sqlSettings
                                   , mpsGenerateLenses
                                    )
import DataStore.Internal
import GHC.Generics

share [mkPersist sqlSettings { mpsGenerateLenses = True }, mkMigrate "migrateAll"] [persistLowerCase|
User json
    name Text
    age Int
    UniqueUserName name
    deriving Eq Show Generic
|]

getUsers :: ConnectionPool -> IO [Entity User]
getUsers pool = flip runSqlPool pool $ selectList [] []

getUser :: ConnectionPool -> Key User -> IO (Maybe (Entity User))
getUser pool = flip runSqlPool pool . getEntity

insertUser :: ConnectionPool -> User -> IO (Maybe (Entity User))
insertUser pool user = flip runSqlPool pool $ do
    mInDb <- getBy $ UniqueUserName $ user^.userName
    case mInDb of
      Just inDb -> pure Nothing
      Nothing   -> do
                     key <- insert user
                     pure $ Just $ Entity key user

migrateDb :: IO ()
migrateDb = doMigration migrateAll

State を使えばConnectionPoolを引数から消せそうですが、まあこれはこれでアリでしょう。

servantと統合

いよいよservantと統合します。ConnectionPoolを受け取ってServantを返す関数を定義するのがポイントです。

{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE TypeOperators              #-}
module App where

import Control.Monad.IO.Class   (liftIO)
import Database.Persist.Sql
import DataStore
import DataStore.Internal       (pgPool)
import Network.Wai.Handler.Warp (run, Port)
import Servant

type ApiDef  = Get '[JSON] [Entity User]
            :<|> "users" :> Get '[JSON] [Entity User]

server :: ConnectionPool -> Server ApiDef
server pool = (liftIO $ getUsers pool)
         :<|> (liftIO $ getUsers pool)

api :: Proxy ApiDef
api = Proxy

app :: ConnectionPool -> Application
app pool = serve api $ server pool

mkApp :: IO Application
mkApp = do
    migrateDb
    pool <- pgPool
    return $ app pool

startServer :: Port -> IO ()
startServer port = do
    putStrLn "{- ----------------------------"
    putStrLn " - start server!"
    putStrLn " ----------------------------- -}"
    run port =<< mkApp

まとめ

このコードに行き着くまでに色々調べて苦労はしたのですが、終わってみれば至極真っ当なコードになりました。

今回はコネクションプールを状態として扱う必要があり、これをどう実現するかがポイントでした。関数の引数として引き回すのは素直な実装だと思います。しかし、引き回したい状態が多くなってきた場合は、関数の引数にするのは難しくなってきます。
そうなるとState(Readerかな)をうまく使う必要が出てくると思います。
Yesodなんかは getYesod という関数で状態をまとめて取得できるようにしているようです。

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
No comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
ユーザーは見つかりませんでした