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

Yesod selectFieldList returning list index number instead of value

我正在尝试 运行 我使用 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 变量。问题在于此变量不包含 cityMapambiguityForm 函数中创建的关联值。相反,我返回了列表的索引号 selection 我制作的包装在 CityText 类型中。

例如,下拉列表有 10 个元素。如果我 select 返回列表的第一个元素 CityText "1"。假设我 select 返回下拉列表中的最后一项 CityText "10".

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

selectField 函数采用 OptionList a 表示从 Haskell 个类型为 a 的对象列表中选择的内容。 OptionList a 是一个包含 Option a 值的列表,它结合了面向用户的 Text 标签、选择的 a 值以及 [= 的 Text 116=]-将由客户端在表单中返回的级别值。 selectFieldList 函数是一种特殊化,它使用递增整数标签表示 HTML 级值,这就是为什么您会看到一系列递增整数而不是表单返回的有意义的值。

因此,您想使用 selectField 代替 selectFieldList。但这还不是故事的结局。据我了解,您正在尝试呈现具有一组动态选择的表单(大概是从数据库查询中生成的)。当表单被 posted 时,您希望收到一个有意义的 HTML 级别的值,这样您就可以无状态地接受它并对其进行操作,而无需记住原始的动态选择集。这样,您就可以绕过 runFormPost 并直接对返回值进行操作。

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

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

所以,你有,说:

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

和一组有效的 Citys:

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

和单子 validate/lookup 针对完整城市列表的键(例如,“0101”):

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

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

无论如何,使用 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 属性是独立的键01010102 我们可以映射回城市。

但是,如果您尝试 POST 此表单,您将返回一个错误:

Invalid entry: 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

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

You chose option City {key = "0102", label = "New Jersey"}

最大的缺点是必须一次提供完整的城市集,这对于有效城市的大型数据库来说不切实际。

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

这就是问题所在。我们需要用我们自己的验证器覆盖 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

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

所有这些都准备就绪后,使用下面的代码,您将获得一个单子动态表单,该表单可以无状态 post 使用所有 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

我最终使用的解决方案是直接修改 selectFieldListoptionsPairs 函数。我仍然不明白为什么这个函数会被设计为 return 所选选项的 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)