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

ServantのハンドラにReaderTを適用する

はじめに

Haskellでは、一般的なプログラミング言語であるような、グローバル「変数」が使えません。そのため、そのような目的の場合には「Readerモナド」を使います。ただし、Readerモナドは、グローバル変数そのものではないため、一部の目的には使えなかったり、実装方法がわかりにくかったりします。

WebAPIフレームワークの1つである「Servant」も、そういったケースの1つです。本記事は、Servant内のAPIハンドラでReaderモナドを使う方法についてのメモ書きです。

Servantバージョンについての注意

2019年3月時点でのServantバージョンは0.16です。少なくとも、Servantのバージョン0.9→0.11→0.12→0.13に至るに従い、本記事のテーマである「ReaderTモナドの適用」についてのBreaking changesが続いています。現時点では、Stackageに登録されているServantの最新バージョン0.15まで適用できる方法について記載します。0.16でも同様の手法が使えるかとは思いますが、今後、この記事の内容はそのままでは使えなくなる可能性もあります。そのため、Servantを使用する場合には、LTSバージョン等に注意する必要があります。

ReaderT適用の必要性

WebAPIハンドラ内部で参照したいものは、いくつかあります。

  • DBにアクセスするために、WebAPI開始時に作成したプール
  • アプリ実行設定(デバッグモード、DB選択、サーバ名設定など)

こういった情報を「Config」という型として定義し、WebAPI開始時に値を設定し、ハンドラ内で読み出しができるようにできればいいわけです。Servantでは、標準では、ハンドラはHandlerモナド(「ExceptT ServantErr IO」相当)として動作します。このHandlerモナドにrunReaderTをかぶせることができれば、ハンドラ内でConfigの値にアクセスできるようになります。

前提

自分で定義する型や関数がわかりやすいように、「MyApp」というプレフィックスをつけています。

MyAppConfig型

MyAppConfig型は好きなメンバを定義できますが、ここでは例として下記のデータ型とします。

data MyAppConfig = MyAppConfig
    { getPool :: ConnectionPool -- DBアクセス用プール
    , getApplicationText :: Text -- アプリ設定テキスト
    , getApplicationFlag :: Bool -- アプリ設定フラグ
    }

MyAppAPI型

URL型定義(例)です。

type MyAppAPI = "person" :> Capture "person_id" PersonId :> Get '[JSON] ApiPerson
           :<|> "person" :> ReqBody '[JSON] ApiPersonReqBody :> Post '[JSON] ApiPerson

ハンドラ登録、アプリ定義

Handlerモナドでのハンドラ登録とアプリ定義の実装(要は、普通の実装)の場合は、下記のようになります。myAppServer関数をトップレベル関数とする場合には、型宣言が必要です。が、このスタイルで書いているサイトを見かけたことがなく、どういう型宣言をしたらいいのかが、長い間わかりませんでした(挙げ句の果てに、Warning抑制に走る、という...)。おそらくこの書き方でいいのでは、と思いますが。

-- ハンドラ登録
myAppServer :: Server MyAppAPI
myAppServer = getPerson
         :<|> postPerson

-- アプリ定義
myAppApi :: Proxy MyAppAPI
myAppApi = Proxy

myAppApp :: Application
myAppApp = serve myAppApi myAppServer

Servant-0.15で利用できる実装

MyAppHandler型定義

ハンドラ用モナドであるHandlerにReaderTを適用した型をMyAppHandler型、とします。つまり、ハンドラの型がhandlerHoge :: 引数の型 -> Handler 戻り値型となっていたところを、handlerHoge :: 引数の型 -> MyAppHandler 戻り値の型となるようにします。

type MyAppHandler = ReaderT MyAppConfig Handler

ハンドラ登録、アプリ定義

「hoistServer」を使って、Server APIおよびApplicationを作成します。ハンドラ登録では、MyAppHandler型からMyAppServerを生成し、これをServer型と置き換えます。

-- ハンドラ登録
type MyAppServer api = ServerT api MyAppHandler

myAppServer :: MyAppServer MyAppAPI
myAppServer = getPerson
         :<|> postPerson

-- アプリ定義
myAppApp :: MyAppConfig -> Application
myAppApp = serve myAppApi . myAppToServer

myAppToServer :: MyAppConfig -> Server MyAppAPI
myAppToServer cfg = hoistServer myAppApi (`runReaderT` cfg) myAppServer

アプリ実行

MyAppConfigの値を作成し、appの引数に与えてrun(実行)します。

  let pool_size = 8
  pool <- runNoLoggingT $ createMySQLPool connect_info pool_size
  let port = 3001
      cfg = MyAppConfig {getPool = pool, getApplicationText = "Fugafuga", getApplicationFlag = True}
  run port $ myAppApp cfg

Servant-0.9.x〜0.12で利用できる実装(obsolete)

ハンドラの型の変換のための関数「myAppToServer」が、バージョン0.12までは「hoistServer(0.13にて新設)」ではなく「enter」を使うものでした。hoistServerになって、runReaderTNatや型変換の指定等が不要となり、すっきりしたものになっています。

myAppToServer :: MyAppConfig -> Server MyAppAPI
myAppToServer cfg = enter (runReaderTNat cfg :: MyAppHandler :~> Handler) myAppServer

Servant-0.9.1.1までの実装(obsolete)

[訂正] 最初に記載したときには、Servant-0.9.1.1以前の場合、下記の実装でないといけない、と思っていましたが、確認したところ、Servant-0.11向けの実装で、Servant-0.9.1.1でも利用可能ということがわかりました。そのため、本節の以下の実装は不要ですが、何かの参考になるかもしれないため、削除せずに残しておきます。

App型定義(obsolete)

newtype MyAppHandler a = MyAppHandler
    { runApp :: ReaderT MyAppConfig (ExceptT ServantErr IO) a
    } deriving ( Functor, Applicative, Monad, MonadReader Config,
                 MonadError ServantErr, MonadIO, MonadThrow, MonadCatch)

アプリ定義 (obsolete)

myAppToServer :: MyAppConfig -> Server MyAppAPI
myAppToServer cfg = enter (myAppConvertApp cfg) MyAppServer

myAppConvertApp :: MyAppConfig -> MyAppHandler :~> ExceptT ServantErr IO
myAppConvertApp cfg = Nat (flip runReaderT cfg . runApp)

ハンドラ内でのDBアクセス

ハンドラでpoolにアクセスできる環境ができましたので、それを利用してDBアクセスできるようになります。

type SqlPersistM' = SqlPersistT (ResourceT IO)

runSql :: (MonadReader Config m, MonadIO m) => SqlPersistM' b -> m b
runSql query = do
    pool <- asks getPool
    liftIO $ runResourceT $ runSqlPool query pool

これを定義しておいて、

getPersonList :: Maybe PersonType -> MyAppHandler [ApiPerson]
getPersonList ptype = runSql $ do
  plist <- select $ from $ \p -> do
    where_ (if M.isNothing ptype then val True else p ^. PersonType ==. val (fromJust ptype))
    return p
 ...以下略

となります。runSql直後のdo配下のブロック内では、1つのトランザクションとして扱われます。

リポジトリ

上記の実装を含んだサンプルコードをGithubに上げています。
https://github.com/cyclone-t/servant-esqueleto-sample

参考にしたサイト

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
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