haskell - Yesod selectFieldList 返回列表索引号而不是值

Question

我正在尝试运行我使用生成的表单selectFieldList。

data CityContainer = CityContainer (Maybe T.Text)
                     deriving Show

ambiguityForm :: [PG.DbCity] -> Html -> MForm Handler (FormResult CityContainer, Widget)
ambiguityForm cities = renderDivs $ CityContainer
    <$> aopt (selectFieldList cityMap) "City" Nothing
    where
      cityMap :: [(T.Text, T.Text)]
      cityMap = W.mkCityStringM cities


data CityText = CityText T.Text
                deriving Show

ambigReciever :: AForm Handler CityText
ambigReciever = CityText
    <$> areq textField "City" Nothing

runAmbiguityF我通过从另一个路由处理程序调用来运行此表单。runAmbiguityF然后调用postAmbiguityR.

runAmbiguityF :: [PG.DbCity] -> Handler Html
runAmbiguityF cs = do
  (widget, enctype) <- generateFormPost (ambiguityForm cs)
  defaultLayout $ 
    [whamlet| 
      <form method=post action=@{AmbiguityR} enctype=#{enctype}> 
        ^{widget}
        <button type="submit">Submit
    |]  


postAmbiguityR :: Handler Html  
postAmbiguityR = do
  ((result, widget), enctype) <- runFormPost (renderDivs ambigReciever)
  case result of --hold :: CityHold
    FormSuccess cityHold -> defaultLayout $ [whamlet|#{show cityHold}|]
    FormFailure x -> 
      defaultLayout
      [whamlet|
          <p>Invalid Input, try again.
          <form method=post action=@{AmbiguityR} enctype=#{enctype}>
              ^{widget}
              <button>Submit
      |]

当我运行这段代码时，我会得到一个下拉菜单，就像我期望的那样，并且能够提交表单。

我得到一个FormSuccess，因此显示了CityHold变量。问题是这个变量不包含cityMap在ambiguityForm函数中创建的关联值。相反，我返回了包含在CityText类型中的列表选择的索引号。

例如说下拉列表有 10 个元素。如果我选择列表的第一个元素，我会回来CityText "1"。假设我选择了我返回的下拉列表中的最后一项CityText "10"。

提交表单时如何获取值而不是索引号？

标签： haskellyesod

Answer 1

该selectField函数OptionList a从类型为 的 Haskell 对象列表中获取一个表示选择a。这OptionList a是一个Option a值列表，它结合了Text面向用户的标签、a被选择Text的值以及将由客户端在表单中返回的 HTML 级值。该selectFieldList函数是对 HTML 级值使用递增整数标签的特化，这就是为什么您会看到一系列递增整数而不是表单返回的有意义值的原因。

所以，你想selectField用selectFieldList. 但这还不是故事的结局。据我了解，您正在尝试呈现具有一组动态选择的表单（可能是从数据库查询中单子生成的）。当表单发布时，您希望收到一个有意义的 HTML 级别的值，这样您就可以无状态地接受并执行它，而无需记住原始的动态选择集。这样，您可以绕过runFormPost并直接处理返回的值。

一般来说，这是一个坏主意！ 通过绕过runFormPost，您将绕过跨站点请求伪造 (CSRF) 保护和表单验证。这可能适用于您的特定情况，如果您的表单中只有一个字段，请注意手动验证返回的 HTML 级别的值，并执行您自己的 CSRF 缓解（或在不受信任的上下文中操作一个问题）。但是，一个更通用的解决方案是可能的，尽管它有点 hacky。

让我用一个独立的例子来说明。对于您的动态下拉菜单，每个选项将涉及三个值，CityHaskell 级别的内部类型（例如，您的 PG.DbCity）和两个Text值：出现在下拉菜单中的用户可见标签，以及一个自包含Key的，将在 HTML 级value属性中发送并传回给您以验证并转换回City.

所以，你有，说：

type Key = Text
data City = City { key :: Key, label :: Text } deriving (Show, Eq)

和一组有效City的 s：

validCities = [City "0101" "New York", City "0102" "New Jersey", City "0200" "Newark"]

在现实世界中，City它可以是一个persist数据库实体，您可以使用Show实例作为其实体键，并使用其他一些方便的文本字段作为其标签。

我将假设您可以在处理程序中单子生成城市的动态子集（例如，通过数据库查询）：

getSomeCities :: Text -> Handler [City]
getSomeCities pfx = return $ filter (pfx `isPrefixOf . label) validCities

并针对完整的城市列表单子验证/查找键（例如，“0101”）：

lookupCity :: Key -> Handler (Maybe City)
lookupCity k = return $ find ((== k) . key) validCities

这里值得注意的是，如果您想成为无状态的，您无法Key根据您发送给客户端的实际选项实际验证返回的值。您只能检查Key在某些更大的上下文中是否有效（例如，是数据库中的某个有效城市）。从安全的角度来看，您需要为客户发布不在您提供的选项中的密钥的可能性做好准备。

selectField无论如何，可以使用以下形式创建一个简单的动态下拉列表：

dropDownForm :: [City] -> Html -> MForm Handler (FormResult City, Widget)
dropDownForm cities = renderDivs $
  areq (selectField ol) "" Nothing

  where ol :: Handler (OptionList City)
        ol = do
          mr <- getMessageRender
          return $ mkOptionList [ Option (mr lbl) city key
                                | city@(City key lbl) <- cities
                                ]

和 GET 处理程序：

getDropdownR :: Handler Html
getDropdownR = do
  -- some dynamic subset of the valid cities
  cities <- getSomeCities "New "
  (widget, enctype) <- generateFormPost (dropDownForm cities)
  defaultLayout [whamlet|
    <form method=post action=@{DropdownR} enctype=#{enctype}>
      ^{widget}
      <button>Submit
    |]

现在，让我们编写一个标准的 POST 处理程序

postDropdownR :: Handler Html
postDropdownR = do
  ((result, _), _) <- runFormPost (dropDownForm [])
  case result of
    FormSuccess opt -> do
      setMessage . toHtml $ "You chose option " <> show opt
    FormFailure txt -> do
      setMessage (toHtml $ Text.unlines txt)
  redirect DropdownR

因为我们使用runFormPost，所以我们对任何其他表单字段都有 CSRF 保护和验证。这里唯一的问题是，由于我们是无国籍的，我们没有可用的城市列表，所以现在我只提供了空列表。

如果你把它放到一个基本的 Yesod 服务器中并查看生成的表单的 HTML，你会看到 HTMLvalue属性是自包含的键0101，0102我们可以映射回城市。

但是，如果您尝试发布此表单，则会收到错误消息：

无效条目：0101

因为selectField验证器正在根据一个空的选项列表验证返回的选项。要做的一件简单的事情是在 中提供完整的有效城市postDropdownR集，而不管发送给客户端的城市子集是什么：

postDropdownR' :: Handler Html
postDropdownR' = do
  ((result, _), _) <- runFormPost (dropDownForm' validCities) -- CHANGE HERE
  case result of
    FormSuccess opt -> do
      setMessage . toHtml $ "You chose option " <> show opt
    FormFailure txt -> do
      setMessage (toHtml $ Text.unlines txt)
  redirect DropdownR

现在，表单可以正常工作并响应如下内容：

您选择了选项 City {key = "0102", label = "New Jersey"}

最大的缺点是必须一次性提供全套城市，这对于有效城市的大型数据库来说是不切实际的。

该OptionList类型提供了一些灵活性，因为它的类型包括olOptions :: [Option a]呈现表单时使用的选项列表和olReadExternal :: Text -> Maybe a用于验证返回的 HTML 级别值的单独函数，但olReadExternal仍然是纯函数，因此无法将其作为数据库查询运行在单子上下文中。

这就是它变得棘手的地方。我们需要用我们自己的验证器覆盖selectField-produced的验证代码。Field这意味着将表单重写为：

dropDownForm :: [City] -> Html -> MForm Handler (FormResult City, Widget)
dropDownForm cities = renderDivs $
  areq (selectField' ol) "" Nothing

  where ol :: Handler (OptionList City)
        ol = do
          mr <- getMessageRender
          return $ mkOptionList [ Option (mr lbl) city key
                                | city@(City key lbl) <- cities
                                ]

        selectField' :: Handler (OptionList City) -> Field Handler City
        selectField' ol = (selectField ol) { fieldParse = fp }

        -- adapted from `selectParser` in Yesod.Form.Fields source
        fp :: [Text] -> [FileInfo] -> Handler (Either (SomeMessage Site) (Maybe City))
        -- apparently, there are several ways of selecting nothing
        fp []         _ = return $ Right Nothing
        fp ("none":_) _ = return $ Right Nothing
        fp ("":_)     _ = return $ Right Nothing
        -- if you have a City key, you need to validate it
        fp (x:_)      _ = Right <$> lookupCity x

这里的变化是我们已经覆盖了中的fieldParse字段，Field因此它使用lookupCitymonadic 函数进行验证。在postDropDown中，我们使用空的城市集切换回runFormPosting，因为城市列表根本不用于验证。

有了所有这些，使用下面的代码，您将获得一个单子动态表单，可以使用所有 Yesod 验证和 CSRF 机制进行无状态发布，并且您可以使用您自己构造的处理程序单子验证返回的城市。

完整代码：

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import Yesod hiding (Key)
import Data.Text (Text)
import Data.List (find)
import qualified Data.Text as Text
import Data.Coerce

data Site = Site
mkYesod "Site" [parseRoutes|
  / DropdownR GET POST
  |]
instance Yesod Site
instance RenderMessage Site FormMessage where
  renderMessage _ _ = defaultFormMessage

type Key = Text
data City = City { key :: Key, label :: Text } deriving (Show, Eq)
validCities = [City "0101" "New York", City "0102" "New Jersey", City "0200" "Newark"]

getSomeCities :: Text -> Handler [City]
getSomeCities pfx = return $ filter (Text.isPrefixOf pfx . label) validCities

lookupCity :: Key -> Handler (Maybe City)
lookupCity k = return $ find ((== k) . key) validCities

dropDownForm :: [City] -> Html -> MForm Handler (FormResult City, Widget)
dropDownForm cities = renderDivs $
  areq (selectField' ol) "" Nothing

  where ol :: Handler (OptionList City)
        ol = do
          mr <- getMessageRender
          return $ mkOptionList [ Option (mr lbl) city key
                                | city@(City key lbl) <- cities
                                ]

        selectField' :: Handler (OptionList City) -> Field Handler City
        selectField' ol = (selectField ol) { fieldParse = fp }

        -- adapted from `selectParser` in Yesod.Form.Fields source
        fp :: [Text] -> [FileInfo] -> Handler (Either (SomeMessage Site) (Maybe City))
        -- apparently, there are several ways of selecting nothing
        fp []         _ = return $ Right Nothing
        fp ("none":_) _ = return $ Right Nothing
        fp ("":_)     _ = return $ Right Nothing
        -- if you have a City key, you need to validate it
        fp (x:_)      _ = Right <$> lookupCity x

getDropdownR :: Handler Html
getDropdownR = do
  -- some dynamic subset of the valid cities
  cities <- getSomeCities "New "
  (widget, enctype) <- generateFormPost (dropDownForm cities)
  defaultLayout [whamlet|
    <form method=post action=@{DropdownR} enctype=#{enctype}>
      ^{widget}
      <button>Submit
    |]

postDropdownR :: Handler Html
postDropdownR = do
  ((result, _), _) <- runFormPost (dropDownForm [])  -- empty city list ignored
  case result of
    FormSuccess opt -> do
      setMessage . toHtml $ "You chose option " <> show opt
    FormFailure txt -> do
      setMessage (toHtml $ Text.unlines txt)
  redirect DropdownR

main :: IO ()
main = warp 3000 Site