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

时间:2020-07-27 21:20:34

标签: haskell yesod

我正在尝试运行使用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

我通过从另一个路由处理程序调用{​​{1}}来运行此表单。 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类型中的列表选择的索引号。

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

提交表格时如何获取值而不是索引号?

2 个答案:

答案 0 :(得分:1)

selectField函数采用OptionList a表示从a类型的Haskell对象列表中选择的内容。 OptionList aOption a值的列表,这些值结合了Text面向用户的标签,a值和HTML的Text客户端将以表格形式返回的级别值。 selectFieldList函数是一种特殊化,它使用递增的整数标签作为HTML级别的值,这就是为什么您看到一系列递增的整数而不是表单返回的有意义的值的原因。

因此,您想使用selectField代替selectFieldList。但这还不是故事的结局。据我了解,您正在尝试使用一组动态选择来呈现表单(可能是通过数据库查询以单例方式生成的)。发布表单后,您希望收到有意义的HTML级别的值,这样您就可以无状态地接受并执行该操作,而无需记住原始的动态选择集。这样,您可以绕过runFormPost并直接对返回的值进行操作。

通常,这是个坏主意!!通过绕过runFormPost,您将绕过跨站点请求伪造(CSRF)保护和表单验证。如果您的表单中只有一个字段,则这可能适用于您的特定情况,请务必手动验证返回的HTML级别的值,并执行自己的CSRF缓解措施(或在不属于这种情况的受信任上下文中运行)一个问题)。但是,尽管有点麻烦,但是可以采用更通用的解决方案。

让我使用一个独立的示例进行说明。对于您的动态下拉菜单,每个选项都涉及三个值:Haskell级别的内部City类型(例如,您的PG.DbCity)和两个Text值:用户可见标签出现在下拉菜单中,并且包含一个自包含的Key,它将以HTML级别的value属性发送,并传递回您进行验证并转换回City

所以,你必须说:

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

和一组有效的City

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

在现实世界中,City可以是persist数据库实体,并且您可以将Show实例用作其实体密钥,并将其他方便的文本字段用作其标签。 / p>

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

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,则会看到HTML value属性是自包含的键0101和{{1} },我们可以映射回城市。

但是,如果您尝试过帐此表格,则会返回一个错误:

无效条目:0101

因为0102验证程序正在针对空的选项列表验证返回的选项。一个简单的事情是在selectField中提供完整的有效城市集,而与发送给客户的城市子集无关:

postDropdownR

现在,该表格可以正常工作并响应以下内容:

您选择了城市{key =“ 0102”,标签=“ New Jersey”}

最大的缺点是必须同时提供全部城市,这对于大量的有效城市数据库来说是不切实际的。

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

这是很容易破解的地方。我们需要使用我们自己的验证器来覆盖olReadExternal产生的selectField的验证码。这意味着将表单重写为:

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单子函数进行验证。在lookupCity中,我们使用一组空城市切换回postDropDown,因为根本没有使用城市列表进行验证。

所有这些都准备就绪,使用下面的代码,您将获得一个动态的表单,该表单可以使用所有Yesod验证和CSRF机制进行无状态发布,并且您可以使用自己的处理程序来对返回的城市进行单个验证自己建造。

完整代码:

runFormPost

答案 1 :(得分:0)

我最终使用的解决方案是直接修改selectFieldListoptionsPairs函数。我仍然不明白为什么要设计此函数来返回所选选项的index + 1而不是返回映射到所述所选内容的值。尽管如此,这是我想出的。

selectFieldList' ::
     (Eq a, Show a, RenderMessage site FormMessage, RenderMessage site msg)
  => [(msg, a)]
  -> Field (HandlerFor site) a
selectFieldList' = selectField . optionsPairs'

optionsPairs' ::
     (Show a, MonadHandler m, RenderMessage (HandlerSite m) msg)
  => [(msg, a)]
  -> m (OptionList a)
optionsPairs' opts = do
  mr <- getMessageRender
  let mkOption external (display, internal) =
          Option { optionDisplay       = mr display
                 , optionInternalValue = internal
                 , optionExternalValue = T.pack $ show external
                 }
      opts' = map snd opts
  return $ mkOptionList (zipWith mkOption opts' opts)