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配下のブロック内では、１つのトランザクションとして扱われます。

リポジトリ

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

参考にしたサイト

• To Overcome servant-persistent updated
  Servantのハンドラでのモナドの取り回しの解説記事です。Servant-0.9.1.1の実装は、ここの記事がベースになっています

• Updating user code after the breaking Enter changes in 0.11
  Servant-0.11でのモナド変換部分の記事です