如何使用 Yesod 检查 intField 中的随机数

Question

我想在 Yesod 中创建自定义验证码，您必须在其中输入基于 IO() 操作的结果来解决随机数学问题。

在 POST 处理程序中评估表单时，正在创建一个新的随机数，而之前的输入是错误的。

我如何设法检查 IO 生成的输入与用户的输入是否正确？

{-# LANGUAGE GADTs #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TemplateHaskell, QuasiQuotes, FlexibleContexts #-}

module Main where

import Yesod
import Data.Text
import Yesod.Form
import System.Random

main :: IO ()
main = warp 3000 Captcha


data Captcha = Captcha

instance Yesod Captcha

instance RenderMessage Captcha FormMessage where
    renderMessage _ _ = defaultFormMessage

mkYesod "Captcha" [parseRoutes|
/          HomeR GET POST
|]


randomMForm :: Html -> MForm Handler (FormResult Int, Widget)
randomMForm token = do
      rand <- liftIO $ randomRIO (0 :: Int ,10 :: Int)
      (iResult, iView) <- mreq (checkIntInput rand) "" Nothing
      let widget = [whamlet|
           ^{token}
                 ^{fvInput iView}
             <input type=submit value="Submit">
             <p> Input this: #{show rand}
          <br>
        |]
      return (iResult, widget)

checkIntInput :: ((RenderMessage (HandlerSite m) FormMessage), (Monad m)) => Int -> Field m Int
checkIntInput n = checkBool (\x -> x == n) nmsg intField
  where msg = "Doesn't match the random number " :: Text
        x = pack $ show n
        nmsg = msg `append` x

getHomeR :: Handler Html
getHomeR = do
       (widget, enctype) <-generateFormPost $ randomMForm
       defaultLayout [whamlet|
              <form method=post enctype=#{enctype}>
                  ^{widget}
                     |]

postHomeR :: Handler Html
postHomeR = do
       ((res,widget), enctype) <- runFormPost $ randomMForm
       case res of
          (FormSuccess i) ->  defaultLayout [whamlet|
                                   <p> You entered the right int: #{show i}
                                   <a href=@{HomeR}> Get back!
                                          |]
          (FormFailure (err:_)) ->  defaultLayout [whamlet|
                                   <p> Error: #{err}
                                   <form method=post enctype=#{enctype}>
                                       ^{widget}
                                   <a href=@{HomeR}> Get back!
                                          |]
          (_) ->  defaultLayout [whamlet|
                                   <p> Total error!
                                   <form method=post enctype=#{enctype}>
                                       ^{widget}
                                   <a href=@{HomeR}> Get back!
                                          |]

这是一个供您自己测试的最小示例。

我还做了一个 webm 来展示如果你想提交一个数字的样子。

Answer 1

您可能需要：

生成随机数
将其存储在用户的会话中
验证表单时，检查会话并比较用户输入

Answer 2

它就像一个魅力！

这是我最初想要创建的代码 - 也许有人想要实现这种数学验证码。 WebM

{-# LANGUAGE GADTs #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TemplateHaskell, QuasiQuotes, FlexibleContexts #-}

module Main where

import Prelude
import Yesod
import Data.Text
import Yesod.Form
import System.Random
import Data.Maybe

main :: IO ()
main = warp 3000 Captcha


data Captcha = Captcha

instance Yesod Captcha

instance RenderMessage Captcha FormMessage where
    renderMessage _ _ = defaultFormMessage

mkYesod "Captcha" [parseRoutes|
/          HomeR GET POST
|]


data MathEquation = Math {x :: Int, y :: Int, result :: Int, function ::  Char}

maybeRead :: Read a => String -> Maybe a
maybeRead (reads -> [(x,"")]) = Just x
maybeRead _                   = Nothing

maybeInt :: String -> Maybe Int
maybeInt = maybeRead

createMathEq :: IO (MathEquation)
createMathEq = do
    a  <- randomRIO (0 :: Int, 100 :: Int)
    b  <- randomRIO (0 :: Int, 100 :: Int)
    f' <- randomRIO (0 :: Int, 2 :: Int)
    let (f, fs) = case f' of
                      0 -> ((+),'+')
                      1 -> ((-),'-')
                      _ -> ((*),'*')
        r =  f a b
    return $ Math a b r fs

randomMForm :: MathEquation -> Html -> MForm Handler (FormResult Int, Widget)
randomMForm (Math x y res fs) token = do
    (iResult, iView) <- mreq intField "" Nothing
    let widget = [whamlet|
         ^{token}
               #{show x} #{fs} #{show y} = ^{fvInput iView}
               Should be: #{show res}
           <input type=submit value="Submit">
        <br>
      |]
    return (iResult, widget)

getHomeR :: Handler Html
getHomeR = do
       equation <- liftIO $ createMathEq
       setSession "captcha" (pack $ show $ result equation)
       (widget, enctype) <-generateFormPost $ randomMForm equation
       defaultLayout [whamlet|
              <form method=post enctype=#{enctype}>
                  ^{widget}
                     |]

postHomeR :: Handler Html
postHomeR = do
       equation <- liftIO $ createMathEq
       mText <- lookupSession "captcha"
       ((res,widget), enctype) <- runFormPost $ randomMForm equation
       case (res, mText) of
          (FormSuccess i, (Just captcha)) ->  case ((Just i) == (maybeInt (unpack captcha))) of
                                              True -> do
                                                  setSession "captcha" (pack $ show $ result equation)
                                                  defaultLayout [whamlet|
                                                            <p> You entered the right int: #{show i}
                                                            <a href=@{HomeR}> Get back!
                                                                   |]
                                              False -> do
                                                  setSession "captcha" (pack $ show $ result equation)
                                                  defaultLayout [whamlet|
                                                          <p> Error: Sorry, the input doesn't match
                                                          <form method=post enctype=#{enctype}>
                                                              ^{widget}
                                                          <a href=@{HomeR}> Get back!
                                                                  |]
      (FormFailure (err:_), _) ->  do
          setSession "captcha" (pack $ show $ result equation)
          defaultLayout [whamlet|
                                   <p> Error: #{err}
                                   <form method=post enctype=#{enctype}>
                                       ^{widget}
                                   <a href=@{HomeR}> Get back!
                                          |]
      (_, _) -> do
          setSession "captcha" (pack $ show $ result equation)
          defaultLayout [whamlet|
                                   <p> Total error!
                                   <form method=post enctype=#{enctype}>
                                       ^{widget}
                                   <a href=@{HomeR}> Get back!
                                          |]

如何使用 Yesod 检查 intField 中的随机数

How to check for a random number in intField with Yesod

haskell

captcha

yesod