使用Servant处理常规表单提交（application/x-www-form-urlencoded）

Question

我该如何使用Servant处理常规表单POST请求？特别是，给定一个类似于HTML表单的内容。

<form action="/check" method="post">
  Solution:
  <input name="code" type="text">
  <input type="submit">
</form>

并且

data CheckResult = Correct | Wrong

instance ToHtml CheckResult
    ...

checkCode :: Text -> Handler CheckResult
checkCode code = if code == "secret" then Correct else Wrong

如何将字符串拼接在一起？

- robx

Answer 1

我想为最近版本的Servant添加一个答案，因为我不得不谷歌各种东西才能组装出完整的、可工作的表单处理版本。

以上答案适用于较早版本的Servant，但我在升级到Servant 0.9时遇到了使用表单的问题。

以下是我是如何做到的。

首先，他们从自定义的Form实现切换到了http-api-data中的实现，因此您需要将其添加到cabal文件中：

some-project.cabal

  build-depends:       base >= 4.7 && < 5
                     , aeson
                     , blaze-html
                     , http-api-data

接下来，您可以像上面一样声明一个表单，但是您可以使用GHC.Generics自动推导出一个FromForm实例：

{-# LANGUAGE DeriveGeneric     #-}

module Html.Contact where

import           GHC.Generics
import           Servant
import           Web.FormUrlEncoded          (FromForm)

data ContactForm = ContactForm
 { cname    :: !T.Text
 , cemail   :: !T.Text
 , cmessage :: !T.Text
 } deriving (Eq, Show, Generic)

instance FromForm ContactForm

之后，您可以在端点中使用来自 Servant 的常规 FormUrlEncoded ContentType：

type ContactApi = "contact" :> ReqBody '[FormUrlEncoded] ContactForm
                                   :> Post '[HTML] Html

几乎忘记了：如何渲染这个东西

你可能需要一个页面来显示你的表单？那么，"name"属性必须与你的表单字段匹配（这是我使用Blaze的方法）:

contactForm :: H.Html
contactForm = H.section ! A.id "contact" ! A.class_ "container contact-us u-full-width u-max-full-width" $
  H.div ! A.class_ "row" $ do
    H.div ! A.class_ "eight columns contact-us-form" $
      H.form ! A.method "post" ! A.action "/contact" $ do
        H.div ! A.class_ "row" $ do
          H.div ! A.class_ "six columns" $
            H.input ! A.class_ "u-full-width" ! A.type_ "text" ! A.name "cname" ! A.placeholder "Name" ! A.id "nameInput"
          H.div ! A.class_ "six columns" $
            H.input ! A.class_ "u-full-width" ! A.type_ "text" !  A.name "cemail" ! A.placeholder "Email" ! A.id "emailInput"
        H.textarea ! A.class_ "u-full-width" ! A.name "cmessage" ! A.placeholder "Message" ! A.id "messageInput" $ ""
        H.input ! A.class_ "button u-pull-right" ! A.type_ "submit" !  A.value "Send"

- erewok

Answer 2

Servant通过数据类型FormUrlEncoded和类FromFormUrlEncoded（在Servant 0.9中更名为FromForm）来支持此功能。

首先，我们定义一个用于表单数据的数据类型，并重写我们的处理程序以接受它。

data CheckRequest = CheckRequest { code :: Text }

checkCode :: CheckRequest -> Handler CheckResult
checkCode (CheckRequest code) = if code == "secret" then Correct else Wrong

然后，我们指定一个类型为application/x-www-form-urlencoded的POST请求体。

type API = "check"
         :> ReqBody '[FormUrlEncoded] CheckRequest
         :> Post '[HTML] CheckResult

现在所需的仅是将 CheckRequest 实例化为 FromFormUrlEncoded。

instance FromFormUrlEncoded CheckRequest where
  --fromFormUrlEncoded :: [(Text, Text)] -> Either String CheckRequest
  fromFormUrlEncoded [("code", c)] = Right (CheckRequest c)
  fromFormUrlEncoded _             = Left "expected a single field `code`"

- robx