我想在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来展示如果你想提交一个数字的样子。
答案 0 :(得分：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!
|]
答案 1 :(得分：1)
您可能需要：