You don't have javascript enabled. Good luck! :(
記事公開日: 2018/08/04
最終更新日: 2020/03/03

変数展開処理の流れ

変数展開記法

hamlet では #{...} という形式で変数展開を行うことができます。

[hamlet|
  #{var}
|]

HTML のエスケープなどもこの段階で行われます。

今回はこの処理の流れを追ってみようと思います。

Text -> Html 型への変換部分

今回は Text 型について処理を追うが、その他の型についても大筋の流れは同じです。

【ステップ1】 toHtml (in yesod-core)

#{var} は実際のところ yesod-core パッケージが再エクスポートしている blaze-htmltoHtml 関数を適用するだけです。

つまり、以下の式と同じです。

toHtml var

【ステップ2】 toHtml (in blaze-html)

toHtml の実装は以下のようになっています。

toHtml :: ToMarkup a => a -> Html
toHtml = toMarkup

toMarkup メソッドは blaze-markup パッケージで定義されています。

【ステップ3】 toMarkup (in blaze-markup)

toMarkup メソッドは ToMarkup 型クラスのメソッドなので、実装は型によって異なります。

今回は Text 型に着目しているため、Text 型のインスタンス定義を確認しましょう。

instance ToMarkup Text where
  toMarkup = text
  preEscapedToMarkup = preEscapedText

text 関数は Text.Blaze.Internal モジュールで定義されています。

【ステップ4】 text (in blaze-markup)

text 関数の実装は以下の通りです。

text :: Text    -- ^ Text to render.
     -> Markup  -- ^ Resulting HTML fragment.
text = content . Text

ここで出現する Text データコンストラクタは ChoiceString 型の値です。

content 関数もまた Text.Blaze.Internal モジュールで定義されています。(export はされていません)

【ステップ5】 content (in blaze-markup)

content 関数の実装は以下の通りです。

content :: ChoiceString -> Markup
content cs = Content cs ()

ここで出現する ContentMarkupM 型の値です。

つまりここまでの流れとまとめると、以下のようになります。

#{var}
= toHtml var
= toMarkup var
= text var
= content $ Text var
= Content (Text var) ()

次は、ディスパッチの処理を追っていきましょう。

ディスパッチ処理

典型的なハンドラは以下のような定義とすることが多いでしょう。

getHomeR :: Handler Html
getHomeR = defaultLayout $ do
  mParam <- lookupGetParam "p"

  [whamlet|
    #{maybe "" id mParam}
  |]

ここで注意する点は getHomeR の型は Handler Text ではなく Handler Html とした点です。

つまり defaultLayout を適用した結果はまだエスケープ処理に移る前段階ということです。

ではどこでエスケープ処理が行われているのでしょう?確認するためにはハンドラが実際に呼び出される場所を特定すれば良いでしょう。

具体的には YesodDispatch 型クラスがハンドラを実際に呼び出しています。

【ステップ1】YesodDispatch 型クラス

ここで少し問題となるのが、YesodDispatch のインスタンスは TH によって自動生成されるという点です。

TH で生成されるコードの確認方法 を参考に生成されるコードを確認してみましょう。

data App = App

mkYesod "App" [parseRoutes|
/check1 Check1R GET
|]

instance Yesod App

getCheck1R :: Handler Html
getCheck1R = defaultLayout $ do
  mParam <- lookupGetParam "p"

  [whamlet|
    #{maybe "" id mParam}
  |]

生成されるコードは次のようになります。(読みやすいように、少々整形しています)

mkYesod "App" $
  [ ResourceLeaf
      Resource
        { resourceName = "Check1R"
        , resourcePieces = [Static "check1"]
        , resourceDispatch =
            Methods
              { methodsMulti = Nothing
              , methodsMethods = ["GET"]
              }
        , resourceAttrs = []
        , resourceCheck = True
        }
  ]
======>
instance ParseRoute App where
  parseRoute (["check1"], _) = Just Check1R
  parseRoute (_, _) = Nothing

instance RenderRoute App where
  data Route App = Check1R
    deriving (Show, Eq, Read)
  renderRoute Check1R = ([pack "check1")], [])

instance RouteAttrs App where
  routeAttrs Check1R {} = fromList []

resourcesApp :: [ResourceTree String]
resourcesApp =
  [ ResourceLeaf
      Resource
        { resourceName = "Check1R"
        , resourcePieces = [Static "check1"]
        , resourceDispatch =
            Methods
              { methodsMulti = Nothing
              , methodsMethods = ["GET"]
              }
        , resourceAttrs = []
        , resourceCheck = True
        }
  ]

type Handler = HandlerFor App
type Widget = WidgetFor App ()

instance YesodDispatch App where
  yesodDispatch env req = helper (pathInfo req)
    where
      helper ["check1"] =
        case requestMethod req of
          "GET" -> yesodRunner getCheck1R env (Just Check1R) req
          _     -> yesodRunner (void badMethod) env (Just Check1R) req
      helper _ = yesodRunner (void notFound) env Nothing req

色々と生成されているが、ここで着目するのは yesodDispatch メソッドです。

その中で yesodRunner getCheck1R env (Just Check1R) req という形で yesodRunner が呼ばれていることがわかります。

【ステップ2】yesodRunner (in yesod-core)

yesodRunner の実装は以下の通りです。(長いので必要な部分のみ抜き出しています)

yesodRunner handler' YesodRunnerEnv {..} route req sendResponse
...
        yar <- runInternalState (runHandler rhe handler yreq') is
...
    handler = yesodMiddleware handler'

まずは yesodMiddleware に適用されますが、型が変化しないためここではエスケープ処理が行われていないことがわかります。

yesodMiddleware :: ToTypedContent res => HandlerFor site res -> HandlerFor site res

次に Yesod.Core.Internal.Run モジュールで定義されている runHandler 関数に制御がうつります。

【ステップ3】runHandler

runHandler の実装は以下の通りです。(ここでも必要な部分のみを掲載しています)

runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -> do
    (state, contents0) <- basicRunHandler rhe handler yreq resState
...

次は basicRunHandler が呼ばれます。

【ステップ4】basicRunHandler

basicRunHandler の実装は以下の通りです。(ここでも必要な部分のみを掲載しています)

basicRunHandler rhe handler yreq resState = do
...
            res <- unHandlerFor handler (hd istate)
            tc <- evaluate (toTypedContent res)
...

次に unHandlerFor が呼ばれます。

【ステップ5】unHandlerFor

unHandlerForHandlerFor 型を剥がすための関数で、実装は以下のようになっています。

newtype HandlerFor site a = HandlerFor
    { unHandlerFor :: HandlerData site site -> IO a
    }
    deriving Functor

ここで HandlerFor site aIO a に変化します。

つまり先程の res の型が Html だということがわかります。

res <- unHandlerFor handler (hd istate)
tc <- evaluate (toTypedContent res)

そのため、次は toTypedContent を見ていく必要があります。

【ステップ6】toTypedContent

toTypedContentToTypedContent 型クラスのメソッドです。

Html 型のインスタンス定義は次のようになっています。

instance ToTypedContent Html where
  toTypedContent h = TypedContent typeHtml (toContent h)

toContent を見てみましょう。

【ステップ7】toContent

toContentToContent 型クラスのメソッドであり Html 型のインスタンス定義は以下のようになっています。

instance ToContent Html where
  toContent bs = ContentBuilder (renderHtmlBuilder bs) Nothing

ここでやっとレンダリング関数の renderHtmlBuilder が出現しました。

レンダリング処理

【ステップ1】renderHtmlBuilder

renderHtmlBuilder の実装は以下の通りです。

import qualified Text.Blaze.Renderer.Utf8 as R

renderHtmlBuilder :: Html -> Builder
renderHtmlBuilder = R.renderMarkupBuilder

【ステップ1】renderMarkupBuilder

renderMarkupBuilder の実装は以下のようになっています。

ここで、この関数に渡される値は Content (Text var) () のような形になっていたことを思い出そう。該当するパターンマッチのみを掲載します。

renderMarkupBuilder :: Markup     -- ^ Markup to render
                  -> Builder  -- ^ Resulting builder
renderMarkupBuilder = go mempty
  where
    go :: Builder -> MarkupM b -> Builder
    ...
    go _ (Content content _) = fromChoiceString content

単純に fromChoiceString を適用するだけのようです。

【ステップ2】fromChoiceString

fromChoiceString の実装は以下のようになっています。

import qualified Blaze.ByteString.Builder           as B
import qualified Blaze.ByteString.Builder.Html.Utf8 as B
...

fromChoiceString :: ChoiceString  -- ^ String to render
                 -> Builder       -- ^ Resulting builder
fromChoiceString (Static s)     = B.copyByteString $ getUtf8ByteString s
fromChoiceString (String s)     = B.fromHtmlEscapedString s
fromChoiceString (Text s)       = B.fromHtmlEscapedText s
fromChoiceString (ByteString s) = B.fromByteString s
fromChoiceString (PreEscaped x) = case x of
    String s -> B.fromString s
    Text   s -> B.fromText s
    s        -> fromChoiceString s
fromChoiceString (External x) = case x of
    -- Check that the sequence "</" is *not* in the external data.
    String s     -> if "</" `isInfixOf` s then mempty else B.fromString s
    Text   s     -> if "</" `T.isInfixOf` s then mempty else B.fromText s
    ByteString s -> if "</" `S.isInfixOf` s then mempty else B.fromByteString s
    s            -> fromChoiceString s
fromChoiceString (AppendChoiceString x y) =
    fromChoiceString x `mappend` fromChoiceString y
fromChoiceString EmptyChoiceString = mempty

今回関係するのは fromChoiceString (String s) = B.fromHtmlEscapedText s なので fromHtmlEscapedText を確認しましょう。

【ステップ3】fromHtmlEscapedText

fromHtmlEscapedString 関数の実装は以下の通りです。

charUtf8HtmlEscaped :: P.BoundedPrim Char
charUtf8HtmlEscaped =
    condB (>  '>' ) (condB (== '\DEL') P.emptyB P.charUtf8) $
    condB (== '<' ) (fixed4 ('&',('l',('t',';')))) $        -- &lt;
    condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $        -- &gt;
    condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $  -- &amp;
    condB (== '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $  -- &#quot;
    condB (== '\'') (fixed5 ('&',('#',('3',('9',';'))))) $  -- &#39;
    condB (\c -> c >= ' ' || c == '\t' || c == '\n' || c == '\r')
          (P.liftFixedToBounded P.char7) $
    P.emptyB
  where
    {-# INLINE fixed4 #-}
    fixed4 x = P.liftFixedToBounded $ const x >$<
      P.char7 >*< P.char7 >*< P.char7 >*< P.char7

    {-# INLINE fixed5 #-}
    fixed5 x = P.liftFixedToBounded $ const x >$<
      P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7

    {-# INLINE fixed6 #-}
    fixed6 x = P.liftFixedToBounded $ const x >$<
      P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7

つまり、この関数内で実際のエスケープ処理が走っていることがわかります。

まとめ

  • <, >, &, ", ' の5文字がエスケープされます。