我正在尝试运行使用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"
下拉列表中选择了最后一项。
提交表格时如何获取值而不是索引号?
答案 0 :(得分:1)
selectField
函数采用OptionList a
表示从a
类型的Haskell对象列表中选择的内容。 OptionList a
是Option 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)
我最终使用的解决方案是直接修改selectFieldList
和optionsPairs
函数。我仍然不明白为什么要设计此函数来返回所选选项的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)