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

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

# Tips

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

柔軟にフォームをデザインしたい場合はMFormを使う。下記のページが詳しい。
[とりあえず雑記帳](https://sites.google.com/site/toriaezuzakki/haskell/yesod/forms)

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

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


## MFormにはショートカットするための型Formがある
MFormを作る関数は型宣言がめんどくさい。

```hs
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)
```

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

```hs
createForm :: Form Text
```

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

hamletではなくhsの中で付ける方法しか見付けていない。いけてない。
setClassという関数を作る。

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

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

```haskell
(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）の参照の追加方法

```hs
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が返ってくる。

```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実行の例。

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

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

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

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

## Middlewareの作り方
Middlewareというのは、全リクエストの前に(後ろもいけるかもしれないが、試していない)処理を挟むもの。JavaのServlet APIでいうところのFilterに当たる。
YesodのMiddlewareは、特に型クラスが提供されているわけではなくて、まずは次のような型の関数を作って

```hs
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にアクセスする場合は型宣言に追記が必要になる。

```hs
dbAccessMiddleware :: (YesodPersist site, YesodPersistBackend site ~ SqlBackend) =>
    HandlerT site IO res -> HandlerT site IO res
```

これには結構はまった。

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

```hs
_ <- runDB $
         insert ...
         >> insert ...
         >> update ...
         >> delete ...
```

## 特定のリソースに対してCSRFチェックを行わないようにする
YesodはCSRF対策のサーバ側処理として``` defaultCsrfMiddleware ```を提供している。ただサーバ側の対処だけでは不充分でクライアント側にも対処が必要なのだが、困ったことにこのクライアント側で対処がなされていない処理が散見される。
中でも困るのがログアウト処理で、単純に``` defaultCsrfMiddleware ```を使うとログアウト処理（=/auth/logoutへのアクセス）でCSRFチェックでNGとなってしまい、ログアウトに失敗してしまう。

![yesod_permission_denied.png](https://qiita-image-store.s3.amazonaws.com/0/10225/c6300754-5c61-b21e-9bec-eb53e1ee7753.png)

これに対処する１つの方法として、特定パスへのアクセス時に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の３つのファイルを同名で作った上で、トップレベルの関数を宣言してwidgetFile関数を使う。

```hs
hogeWidget :: Widget
hogeWidget $(widgetFile "hoge")
```

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

```
^{hogeWidget}
```

と書けばWidgetを使える。

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

## 引数を取るWidget

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

```hs
hogeWidget :: Text -> Widget
hogeWidget foo = $(widgetFile "hoge")
```

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

```
^{hogeWidget "bar"}
```

## DBへのSELECTでIN句を使う

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

次のように使う。

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

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

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

型は以下。
[FilterOr :: [Filter record] -> Filter record](https://hackage.haskell.org/package/persistent-2.5/docs/Database-Persist-Types.html#v:FilterOr)

コード例は次の通り。

```hs
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](https://hackage.haskell.org/package/time-1.6.0.1/docs/Data-Time-LocalTime.html#v:utcToLocalZonedTime)

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


```hs
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氏のブログ](http://www.yesodweb.com/blog/2013/04/mixin-support-in-lucius)を参照すること。

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

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

[StackOverflow](http://stackoverflow.com/questions/15712186/manually-render-a-routes-url)にあった。

```hs
render <- getUrlRender
path   <- return $ render HomeR
```

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

```hs
getResourcePath :: MonadHandler m => Route (HandlerSite m) -> m Text
getResourcePath resource = do
    renderFunction <- getUrlRender
    return $ renderFunction resource
```

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

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

## クエリパラメータを得る
lookupGetParam関数がお手軽。

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

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

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

* Yesod.Core.Content
* Yesod.Core.TypedContent
* Data.Aeson.ToJSON

最後のToJSONは必須ではないが、JSONとして返すのであればインスタンスにしておくとよい。
このような型の典型的なコードは次のようになる。

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

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

```hs
getOrderRowsJsonR :: Handler [OrderRow]
```



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

```hs
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.メッセージファイルを読み込む

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

```hs
mkMessage "App" "message" "ja"
```

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

```html
<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.hs```の```makeFoundation```関数の中に書ける。

### 書き方
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を書くとよい。