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宣言がある。
-- | 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'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として機能するようだ。
-- 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となってしまい、ログアウトに失敗してしまう。
これに対処する１つの方法として、特定パスへのアクセス時にCSRF対策を行わないようにするMiddlewareを作り、defaultCsrfMiddlewareの代わりに使うようにする。
以下サンプルコード。
{-# 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を使っている行を以下のように書き換える。
yesodMiddleware = srfMiddleware (AuthR LogoutR) . defaultYesodMiddleware
認証の制御
あるリソースを認証済みでないとアクセス出来ないようにするにはFoundation.hs内のisAuthorized関数の定義を編集する。
デフォルトでは以下のようになっていると思う。
-- 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というリソースへのアクセスに認証が必要なようにするには、次のように修正する。
-- 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追記)
認証が必要なリソースに対する記述が誤っていたので修正。修正前のコードは以下。
-- 認証が必要なリソース
isAuthorized ManagerR _ = return AuthenticationRequired
これでは認証済みかどうかに依らずManagerRにアクセスする度にログイン画面にリダイレクトされてしまい、使い物になりません。
Widgetを作る
HTML/CSS/JavaScriptをまとめてコンポーネント化したものをWidgetと呼ぶようだ。
Widgetを作るにはhamlet/lucius/juliusの３つのファイルを同名で作った上で、トップレベルの関数を宣言してwidgetFile関数を使う。
hogeWidget :: Widget
hogeWidget $(widgetFile "hoge")
こうしておけばhamletファイルの中で
^{hogeWidget}
と書けばWidgetを使える。
なお「３つのファイルを作る」と書いたが、常に３つ全てを作る必要はなくて、必要なもののみ作ればよい。
引数を取る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 の中で使われている。
メッセージファイルを作る、使う
手順としては概ね以下のようになる。
- メッセージファイルを作る
- メッセージファイルを読み込む
- hamletファイルの中で使う
1.メッセージファイルを作る
場所は任意。以下のような書式で作る。
Hoge: ほげほげ
Piyo name@Text piyo@Text: #{name}は#{piyo}です。
２行目は引数を取るパターン。
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実装を変更する。
修正前）
makeSessionBackend _ = Just <$> defaultClientSessionBackend
120 -- timeout in minutes
"config/client_session_key.aes"
上記は120分になっている。これを変更する。なお「0以下にしたらタイムアウトしなくなるのではないか」と思うかもしれないが、これはNG。セッションが一瞬たりとも維持されなくなるので、事実上セッション管理がされなくなる。
セッション管理を行わないようにする
場合によってはYesodのセッション管理を使いたくない場合があると思う。
この場合、Foundation.hsのmakeSessionBackendでNothingを返すようにすればよい。
修正前
makeSessionBackend _ = Just <$> defaultClientSessionBackend
120 -- timeout in minutes
"config/client_session_key.aes"
修正後
makeSessionBackend _ = pure Nothing
こうするとセッション管理のためのクッキーがクライアントにセットされなくなる。
セッションを使う必要性が無い場合はこの対処をしておくとよい。
Webサーバ起動時にDBに対して処理を行う
Webサーバ起動時にDBに対して処理を行いたいことがある。
例えば設定値テーブルにデフォルト値を突っ込むとか。
これが正しいのかどうかは分からないのだが、このような処理はApplication.hsのmakeFoundation関数の中に書ける。
書き方
Yesodのテンプレートで作成したmakeFoundation関数の中には次のような処理がある。
-- Perform database migration using our application's logging settings.
runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
これを真似してDBに対する処理を追加することが出来る。
サンプルは以下。このサンプルではinitializeDbDataという関数を呼んでいる。
-- 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も使える。
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を書くとよい。