How to check random number in intField with Yesod

Question

I want to create a custom captcha in Yesod, where you have to enter the result based on the IO () action to solve a random math question.

When evaluating a form, a new random number is created in the POST handler, and the previous input is incorrect.

How can I check if input with IO input with user input is entered correctly?

{-# 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!
                                          |]

Here is a minimal test example.

I also did webm to show how it looks if you want to send a number.

Answer 1

You will most likely need:

• Generate random number
• Store in user session

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!
                                          |]