Trans MsgCsrfWarning

This commit is contained in:
Michael Snoyman 2011-05-20 07:59:34 +03:00
parent 7a9f7cf798
commit 4651ae8b69
2 changed files with 7 additions and 5 deletions

View File

@ -69,6 +69,7 @@ data FormMessage = MsgInvalidInteger Text
| MsgInvalidMinute Text | MsgInvalidMinute Text
| MsgInvalidSecond Text | MsgInvalidSecond Text
| MsgInvalidDay | MsgInvalidDay
| MsgCsrfWarning
defaultFormMessage :: FormMessage -> Text defaultFormMessage :: FormMessage -> Text
defaultFormMessage (MsgInvalidInteger t) = "Invalid integer: " `mappend` t defaultFormMessage (MsgInvalidInteger t) = "Invalid integer: " `mappend` t
@ -81,6 +82,7 @@ defaultFormMessage (MsgInvalidEmail t) = "Invalid e-mail address: " `mappend` t
defaultFormMessage (MsgInvalidHour t) = "Invalid hour: " `mappend` t defaultFormMessage (MsgInvalidHour t) = "Invalid hour: " `mappend` t
defaultFormMessage (MsgInvalidMinute t) = "Invalid minute: " `mappend` t defaultFormMessage (MsgInvalidMinute t) = "Invalid minute: " `mappend` t
defaultFormMessage (MsgInvalidSecond t) = "Invalid second: " `mappend` t defaultFormMessage (MsgInvalidSecond t) = "Invalid second: " `mappend` t
defaultFormMessage MsgCsrfWarning = "As a protection against cross-site request forgery attacks, please confirm your form submission."
intField :: (Monad monad, Integral i) => Field (GGWidget master monad ()) FormMessage i intField :: (Monad monad, Integral i) => Field (GGWidget master monad ()) FormMessage i
intField = Field intField = Field

View File

@ -2,6 +2,7 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
module Yesod.Form.Functions module Yesod.Form.Functions
( -- * Running in Form monad ( -- * Running in Form monad
newFormIdent newFormIdent
@ -26,6 +27,7 @@ module Yesod.Form.Functions
) where ) where
import Yesod.Form.Types import Yesod.Form.Types
import Yesod.Form.Fields (FormMessage (MsgCsrfWarning))
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST) import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
@ -141,7 +143,8 @@ aopt a b = formToAForm . mopt a b
runFormGeneric :: Monad m => Form master m a -> master -> [Text] -> Maybe (Env, FileEnv) -> m (a, Enctype) runFormGeneric :: Monad m => Form master m a -> master -> [Text] -> Maybe (Env, FileEnv) -> m (a, Enctype)
runFormGeneric form master langs env = evalRWST form (env, master, langs) (IntSingle 1) runFormGeneric form master langs env = evalRWST form (env, master, langs) (IntSingle 1)
runFormPost :: (Html -> Form master (GHandler sub master) (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype) runFormPost :: RenderMessage master FormMessage
=> (Html -> Form master (GHandler sub master) (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
runFormPost form = do runFormPost form = do
req <- getRequest req <- getRequest
let nonceKey = "_nonce" let nonceKey = "_nonce"
@ -159,13 +162,10 @@ runFormPost form = do
case (res, env) of case (res, env) of
(FormSuccess{}, Just (params, _)) (FormSuccess{}, Just (params, _))
| lookup nonceKey params /= reqNonce req -> | lookup nonceKey params /= reqNonce req ->
FormFailure [csrfWarning] FormFailure [renderMessage m langs MsgCsrfWarning]
_ -> res _ -> res
return ((res', xml), enctype) return ((res', xml), enctype)
csrfWarning :: Text
csrfWarning = "As a protection against cross-site request forgery attacks, please confirm your form submission." -- TRANS
runFormPostNoNonce :: (Html -> Form master (GHandler sub master) (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype) runFormPostNoNonce :: (Html -> Form master (GHandler sub master) (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
runFormPostNoNonce form = do runFormPostNoNonce form = do
req <- getRequest req <- getRequest