Edited at

Yesod開発に苦労した箇所のメモ

More than 3 years have passed since last update.

stackのおかげでYesod開発が安定するようになった嬉しさは筆舌に尽くしがたい。ここでは実際にYesodでWebアプリを作りながら得た知見をつど公開していく。


Tips


フォームを自由にデザインする

柔軟にフォームをデザインしたい場合はMFormを使う。下記のページが詳しい。

とりあえず雑記帳


MFormを使うときはHtmlを引数に取ること

CSRF防止のトークンをレンダリングするために、Htmlを引数に取る必要がある。そうしないとgenerateFormPost関数やrunFormPost関数の引数の型が合わない。


MFormにはショートカットするための型Formがある

MFormを作る関数は型宣言がめんどくさい。

createForm :: Html -> MForm Handler (FormResult Text, Widget)

実はFouncation.hsにこの型を短く書くためのtype宣言がある。


Foundation.hs

-- | A convenient synonym for creating forms.

type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)

これを使うと次のように書ける.

createForm :: Form Text


MFormで組み立てるフォームにclass属性値を付ける方法

hamletではなくhsの中で付ける方法しか見付けていない。いけてない。

setClassという関数を作る。

emptyFieldSettings :: FieldSettings site

emptyFieldSettings = ""

setClass :: Text -> FieldSettings site
setClass = addClass emptyFieldSettings

addClass :: FieldSettings site -> Text -> FieldSettings site
addClass fs value = fs { fsAttrs = newAttrs }
where newAttrs = addClass' value (fsAttrs fs)

addClass' :: Text -> [(Text, Text)] -> [(Text, Text)]
addClass' klass [] = [("class", klass)]
addClass' klass (("class", old):rest) = ("class", T.concat [old, " ", klass]) : rest
addClass' klass (other :rest) = other : addClass' klass rest

使う側は次のようになる。

(valueResult, view) <- mreq textField (setClass "form-control") Nothing


新しいモジュールを追加する時に忘れてはいけないこと

例えばHandler.Xxxというモジュールを追加したら、次のファイルに追記が必要。


  • Application.hs : import Handler.Xxxを追記

  • <プロジェクト名>.cabal : library > exposed-modulesに追記

実はyesod add-handlerというコマンドを使えば、上記の追記に加えてHandlerやテスト雛形の作成までやってくれる。こちらを使うのも一つの手。


ルーティングの注意点

config/routes の設定の仕方の注意点。

次の設定は両立できない。

/new PageNewR GET POST

/#PageId PageR GET POST

(2016/1/8追記)

次のように書けば両立できることが分かった。

/new      PageNewR GET POST

!/#PageId PageR GET POST


staticなファイル(CSSやJS)の参照の追加方法

addScript $ StaticR js_script_js

StaticRを挟むのがポイント。

静的ファイルを新しく追加すると以下のエラーが出ることがある。

Not in scope: 'js_script_js'

この場合はビルドをやり直す必要があるっぽい。stackを使っているなら次のコマンドを実行する。

rm -fr dist

stack clean & stack build


ライブラリを追加するには

例えば、timeモジュールを使うには <プロジェクト名>.cabalファイルのlibrary > build-dependsに time と追記する。

さらに、PCに初めて導入するライブラリの場合、 stack build を実行しておく必要がある。


Ajaxる

普通にPOSTするとCSRF対策のトークンエラーになる。この場合、以下のようなHTMLが返ってくる。

<p>A valid CSRF token wasn&#39;t present in HTTP headers or POST parameters. Check the Yesod.Core.Handler docs of the yesod-core package for details on CSRF protection.</p>

実はYesodは、scriptタグの中にCSRF対策のトークンをトップレベルのスコープのvar変数として定義してくれていて、これをリクエストヘッダに仕込めばCSRFチェックを行ってくれる。

下記はSuperAgentを使ったAjax実行の例。

request.get(url)

.set(csrfHeaderName, csrfToken) // Yesodが定義しているvar変数を使っている
.end(function(err, res) {
...
});


CSRF対策のトークン値を得る

reqTokenという関数でトークンを取得できる。ワンライナーで書くならこんな感じか。

token   <- getRequest >>= return . maybe "" id . reqToken

reqToken関数はMaybeを戻す。Nothingの時の処理が上記でいいかどうかは、一考の余地があるだろう。


Middlewareの作り方

Middlewareというのは、全リクエストの前に(後ろもいけるかもしれないが、試していない)処理を挟むもの。JavaのServlet APIでいうところのFilterに当たる。

YesodのMiddlewareは、特に型クラスが提供されているわけではなくて、まずは次のような型の関数を作って

customMiddleware :: HandlerT site IO res -> HandlerT site IO res

Foundation.hsに追記すれば、Middlewareとして機能するようだ。


Foundation.hs

    -- Yesod Middleware allows you to run code before and after each handler function.

-- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
-- The defaultCsrfMiddleware:
-- a) Sets a cookie with a CSRF token in it.
-- b) Validates that incoming write requests include that token in either a header or POST parameter.
-- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
yesodMiddleware = defaultCsrfMiddleware . defaultYesodMiddleware . customMiddleware


Middleware内でDBアクセスを行うなら型宣言に注意

Middlewareの作り方は前述した通りだが、中でDBにアクセスする場合は型宣言に追記が必要になる。

dbAccessMiddleware :: (YesodPersist site, YesodPersistBackend site ~ SqlBackend) =>

HandlerT site IO res -> HandlerT site IO res

これには結構はまった。


トランザクションの境界

runDBでまとめた操作は同一トランザクションで実行される。

_ <- runDB $

insert ...
>> insert ...
>> update ...
>> delete ...


特定のリソースに対してCSRFチェックを行わないようにする

YesodはCSRF対策のサーバ側処理としてdefaultCsrfMiddlewareを提供している。ただサーバ側の対処だけでは不充分でクライアント側にも対処が必要なのだが、困ったことにこのクライアント側で対処がなされていない処理が散見される。

中でも困るのがログアウト処理で、単純にdefaultCsrfMiddlewareを使うとログアウト処理(=/auth/logoutへのアクセス)でCSRFチェックでNGとなってしまい、ログアウトに失敗してしまう。

yesod_permission_denied.png

これに対処する1つの方法として、特定パスへのアクセス時にCSRF対策を行わないようにするMiddlewareを作り、defaultCsrfMiddlewareの代わりに使うようにする。

以下サンプルコード。


Middleware.hs

{-# LANGUAGE OverloadedStrings #-}

module Lib.Middleware (
csrfMiddleware
) where

import GHC.Base
import Yesod
import Network.Wai (Request(rawPathInfo))
import Data.Textual.Encoding (decodeUtf8)
import Data.Text (Text, isSuffixOf)

csrfMiddleware :: Yesod site =>
Route site -> HandlerT site IO res -> HandlerT site IO res
csrfMiddleware logoutRoute handler = do
path <- getRequestPath
renderFunc <- getUrlRender
logoutPath <- return $ renderFunc logoutRoute
if isSuffixOf path logoutPath then
handler
else
defaultCsrfMiddleware handler

getRequestPath :: MonadHandler m => m Text
getRequestPath = getRequest
>>= return . reqWaiRequest
>>= return . rawPathInfo
>>= return . decodeUtf8


上記Middlewareを使うには、Foundation.hsの中のdefaultCsrfMiddlewareを使っている行を以下のように書き換える。


Foundation.hs

yesodMiddleware = srfMiddleware (AuthR LogoutR) . defaultYesodMiddleware



認証の制御

あるリソースを認証済みでないとアクセス出来ないようにするにはFoundation.hs内のisAuthorized関数の定義を編集する。

デフォルトでは以下のようになっていると思う。


Foundation.hs

-- Routes not requiring authentication.

isAuthorized (AuthR _) _ = return Authorized
isAuthorized FaviconR _ = return Authorized
isAuthorized RobotsR _ = return Authorized
-- Default to Authorized for now.
isAuthorized _ _ = return Authorized

例えばManagerRというリソースへのアクセスに認証が必要なようにするには、次のように修正する。


Foundation.hs

-- Routes not requiring authentication.

isAuthorized (AuthR _) _ = return Authorized
isAuthorized FaviconR _ = return Authorized
isAuthorized RobotsR _ = return Authorized
-- 認証が必要なリソース. 認証済みであるかどうかをmaybeAuthIdで判定している
isAuthorized ManagerR _ = maybeAuthId >>= return . maybe AuthenticationRequired (\_ -> Authorized)
-- Default to Authorized for now.
isAuthorized _ _ = return Authorized

(2016/2/11追記)

認証が必要なリソースに対する記述が誤っていたので修正。修正前のコードは以下。


Foundation.hs

-- 認証が必要なリソース

isAuthorized ManagerR _ = return AuthenticationRequired

これでは認証済みかどうかに依らずManagerRにアクセスする度にログイン画面にリダイレクトされてしまい、使い物になりません。


Widgetを作る

HTML/CSS/JavaScriptをまとめてコンポーネント化したものをWidgetと呼ぶようだ。

Widgetを作るにはhamlet/lucius/juliusの3つのファイルを同名で作った上で、トップレベルの関数を宣言してwidgetFile関数を使う。

hogeWidget :: Widget

hogeWidget $(widgetFile "hoge")

こうしておけばhamletファイルの中で

^{hogeWidget}

と書けばWidgetを使える。

なお「3つのファイルを作る」と書いたが、常に3つ全てを作る必要はなくて、必要なもののみ作ればよい。


引数を取るWidget

例えばText型のfooという変数を取るWidgetを作る例。

hogeWidget :: Text -> Widget

hogeWidget foo = $(widgetFile "hoge")

使う側は、hamletファイルの中で引数を指定すれば良い。

^{hogeWidget "bar"}


DBへのSELECTでIN句を使う

<-. 演算子がINに当たる。

次のように使う。

cs <- runDB $ selectList [UserId <-. userIds] []


DBの抽出条件でOrを使うには

Filter 型に FilterOr データコンストラクタがある。これを使えばOr条件が作れる。

型は以下。

FilterOr :: [Filter record] -> Filter record

コード例は次の通り。

selectList

[FilterOr [OrderDetailGoBack ==. True, OrderDetailAcceptGoBack ==. True]]
[Desc OrderDetailDate]


modelでのUTCTimeの扱い

UTCTimeはmodelのフィールドに定義することができる型だが、ちょっと挙動に癖がある。


  • Data.Time.getCurrentTimeで取得できるのはUTC

  • DBに書き込まれるときはローカルのタイムゾーンが反映された時刻

  • DBから取得したらUTCに戻る

個人的には、DBにもUTCで格納して欲しかった(もしかすると何らかの設定でいけるのかもしれないが)。

DBから取り出した時刻はUTCなので、そのまま画面に出すと日本時間とはずれて見えることになる.

このズレに対処するには Data.Time.Local.utcToLocalZonedTime を使ってUTCからローカルタイムゾーンでの時刻に変換すると良い.

utcToLocalZonedTime :: UTCTime -> IO ZonedTime

見ての通り結果には IO が付くので、場合によっては(例えばHandlerモナドの中では) liftIO が必要になる.

getHogeR :: Handler html

getHogeR = do
...
zonedNow <- liftIO $ (getCurrentTime >>= utcToLocalZonedTime)
...


全画面に共通するCSS/JavaScriptを書く場所

template/default-layout.luciusにCSSを

template/default-layout.juliusにJavaScriptを書く。

これらのファイルは初期状態では存在しないので、新たに作る必要がある。


CSS(Lucius)のMixinの作り方

luciusファイルでよく使う記述をMixinとして共通化できる。

Snoyman氏のブログを参照すること。

ちなみに、個人的にはLuciusよりCassiusの方が書きやすいのだが、CassiusではMixinが期待通り動作しなかった。なんとかしたい。


Haskellコードの中でリソースからパスを得る

StackOverflowにあった。

render <- getUrlRender

path <- return $ render HomeR

汎用的な関数を作るなら、次のような感じになる。

getResourcePath :: MonadHandler m => Route (HandlerSite m) -> m Text

getResourcePath resource = do
renderFunction <- getUrlRender
return $ renderFunction resource

例えば、次のように使う。

homePath <- getResourcePath HomeR

pagePath <- getResource $ PageR pageId -- routesに /page/#PageId PageR GET と書かれていると仮定


クエリパラメータを得る

lookupGetParam関数がお手軽。

lookupGetParam :: MonadHandler m => Text -> m (Maybe Text)


JSONを戻すハンドラ関数を型安全にする

次の型クラスのインスタンスである型は、ハンドラ関数の戻り値にできる。


  • Yesod.Core.Content

  • Yesod.Core.TypedContent

  • Data.Aeson.ToJSON

最後のToJSONは必須ではないが、JSONとして返すのであればインスタンスにしておくとよい。

このような型の典型的なコードは次のようになる。

data OrderRow = OrderRow { orderRowOrderDetailId :: Key OrderDetail

, orderRowGoodsName :: Text
, orderRowGoodsPrice :: Int
, orderRowAmount :: Int
, orderRowUserName :: Text
, orderRowRoomNumber :: Text
, orderRowWillDeliver :: Bool
, orderRowPostPath :: Text
} deriving (Show, Generic)
instance ToContent [OrderRow] where
toContent = toContent . encode
instance ToTypedContent [OrderRow] where
toTypedContent = TypedContent "application/json" . toContent
instance ToJSON OrderRow
instance FromJSON OrderRow

このような型はハンドラ関数の戻り値に使える。

getOrderRowsJsonR :: Handler [OrderRow]

ちなみにreturnJson関数を使えばToJSON型クラスを実装する型を返すことはできる。

data OrderRow = OrderRow { orderRowOrderDetailId :: Key OrderDetail

, orderRowGoodsName :: Text
, orderRowGoodsPrice :: Int
, orderRowAmount :: Int
, orderRowUserName :: Text
, orderRowRoomNumber :: Text
, orderRowWillDeliver :: Bool
, orderRowPostPath :: Text
} deriving (Show, Generic)
instance ToJSON OrderRow
instance FromJSON OrderRow

getOrderRows :: [Filter OrderDetail] -> Handler Value
getOrderRows = ...
returnJson ret

しかしこれだとValueが汎用的すぎて、実際にどの型を返す関数なのか分からない。なので面倒くさがらずにContent型クラスとTypedContent型クラスも実装すべき。


メッセージを表示する

setMessage関数を使う。

ちなみにこの関数で設定したメッセージは default-layout.hamlet の中で使われている。


メッセージファイルを作る、使う

手順としては概ね以下のようになる。

1. メッセージファイルを作る

2. メッセージファイルを読み込む

3. hamletファイルの中で使う


1.メッセージファイルを作る

場所は任意。以下のような書式で作る。



Hoge: ほげほげ

Piyo name@Text piyo@Text: #{name}は#{piyo}です。

2行目は引数を取るパターン。


2.メッセージファイルを読み込む

Foundation.hs のどこかで mkMessage 関数を呼び出すことでメッセージファイルを読み込む。これにより各メッセージを呼び出す関数が生成される。

mkMessage "App" "message" "ja"


3.hamletファイルの中で使う

<h1>_{MsgHoge}</h1>

<h2>_{MsgPiyo "jabara" "ぴよ"}

参考にしたサイト

http://www.sampou.org/cgi-bin/haskell.cgi?Yesod%3AInternationalization


認証プラグインを作る


hamletの中ならどこででも使える関数を定義する場所

Foundation.hsに書くのが良いみたい。


セッションタイムアウト時間を変更する

Foundation.hsのmakeSessionBackend実装を変更する。

修正前)


Foundation.hs

    makeSessionBackend _ = Just <$> defaultClientSessionBackend

120 -- timeout in minutes
"config/client_session_key.aes"

上記は120分になっている。これを変更する。なお「0以下にしたらタイムアウトしなくなるのではないか」と思うかもしれないが、これはNG。セッションが一瞬たりとも維持されなくなるので、事実上セッション管理がされなくなる。


セッション管理を行わないようにする

場合によってはYesodのセッション管理を使いたくない場合があると思う。

この場合、Foundation.hsのmakeSessionBackendでNothingを返すようにすればよい。

修正前


Foundation.hs

   makeSessionBackend _ = Just <$> defaultClientSessionBackend

120 -- timeout in minutes
"config/client_session_key.aes"

修正後


Foundation.hs

    makeSessionBackend _ = pure Nothing


こうするとセッション管理のためのクッキーがクライアントにセットされなくなる。

セッションを使う必要性が無い場合はこの対処をしておくとよい。


Webサーバ起動時にDBに対して処理を行う

Webサーバ起動時にDBに対して処理を行いたいことがある。

例えば設定値テーブルにデフォルト値を突っ込むとか。

これが正しいのかどうかは分からないのだが、このような処理はApplication.hsmakeFoundation関数の中に書ける。


書き方

Yesodのテンプレートで作成したmakeFoundation関数の中には次のような処理がある。


Application.hs

-- Perform database migration using our application's logging settings.

runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc

これを真似してDBに対する処理を追加することが出来る。

サンプルは以下。このサンプルではinitializeDbDataという関数を呼んでいる。


Application.hs

-- Perform database migration using our application's logging settings.

runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc

-- DB処理を追加
runLoggingT (runSqlPool (initializeDbData) pool) logFunc


そしてinitializeDbData関数の中では、selectListなど、Database.Persistモジュールの関数が使える。各Modelも使える。


Applicatin.hs

initializeDbData = do

l::(Maybe (Entity SystemConfiguration)) <- selectFirst [] []
case l of
Nothing -> do
now <- liftIO $ getCurrentTime
sc <- pure $ SystemConfiguration {
_systemConfigurationValue = "XXXX"
}
_ <- insert sc
pure ()
Just _ -> pure ()


The type signature for ‘<関数名>’ lacks an accompanying bindingというエラーに遭遇したら


意味

型宣言はあるが実装がない。


対処

たいていの場合、実装のつもりで書いた関数名が間違っている。


moduleを追加したらビルド時になんだかとても難しいエラーが出るようになったら

例えば、以下のようないかにも恐ろしいエラーが出ることがある。

--  While building package foo-0.0.0 using:

/hoge/.stack/setup-exe-cache/x86_64-osx/setup-Simple-Cabal-1.22.5.0-ghc-7.10.3 --builddir=.stack-work/dist/x86_64-osx/Cabal-1.22.5.0 build lib:foo exe:foo --ghc-options " -ddump-hi -ddump-to-file"
Process exited with code: ExitFailure 1
Logs have been written to: /hoge/piyo/Haskell/foo/.stack-work/logs/foo-0.0.0.log

Configuring foo-0.0.0...
Preprocessing library foo-0.0.0...
In-place registering foo-0.0.0...
Preprocessing executable 'foo' for foo-0.0.0...
Linking .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/foo/foo ...
Undefined symbols for architecture x86_64:
"_minibzu6jcYxfHTQpa3YhdJgYT98o_fooziCss_baseBackColor_closure", referenced from:
_rMeD_closure in libHSfoo-0.0.0-6jcYxfHTQpa3YhdJgYT98o.a(Foundation.o)
_minibzu6jcYxfHTQpa3YhdJgYT98o_HandlerziGameUi_getGameUiR23_closure in libHSfoo-0.0.0-6jcYxfHTQpa3YhdJgYT98o.a(GameUi.o)
"_minibzu6jcYxfHTQpa3YhdJgYT98o_fooziCss_baseFontColor1_closure", referenced from:
_rMeE_info in libHSfoo-0.0.0-6jcYxfHTQpa3YhdJgYT98o.a(Foundation.o)
_SMYd_srt in libHSfoo-0.0.0-6jcYxfHTQpa3YhdJgYT98o.a(Foundation.o)
_minibzu6jcYxfHTQpa3YhdJgYT98o_HandlerziGameUi_getGameUiR30_info in libHSfoo-0.0.0-6jcYxfHTQpa3YhdJgYT98o.a(GameUi.o)
_S10O4_srt in libHSfoo-0.0.0-6jcYxfHTQpa3YhdJgYT98o.a(GameUi.o)
ld: symbol(s) not found for architecture x86_64
clang: error: linker command failed with exit code 1 (use -v to see invocation)

パスなんかは適当に変えてある。


対処

追加moduleをcabalファイルに書き忘れているとこのエラーになるっぽい。

なのでcabalファイルのexposed-modulesに追加したmoduleを書くとよい。