yesod-form: Use constTimeEq when checking XSRF token (fixes #388).
This commit is contained in:
parent
3e158ac4a5
commit
d1f9a30efa
@ -45,6 +45,7 @@ import Control.Arrow (second)
|
||||
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad (liftM, join)
|
||||
import Crypto.Classes (constTimeEq)
|
||||
#if MIN_VERSION_blaze_html(0, 5, 0)
|
||||
import Text.Blaze (Markup, toMarkup)
|
||||
#define Html Markup
|
||||
@ -62,6 +63,7 @@ import Data.Monoid (mempty)
|
||||
import Data.Maybe (listToMaybe, fromMaybe)
|
||||
import Yesod.Message (RenderMessage (..))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Arrow (first)
|
||||
|
||||
@ -197,9 +199,12 @@ $newline never
|
||||
let res' =
|
||||
case (res, env) of
|
||||
(FormSuccess{}, Just (params, _))
|
||||
| Map.lookup tokenKey params /= fmap return (reqToken req) ->
|
||||
| not (Map.lookup tokenKey params === reqToken req) ->
|
||||
FormFailure [renderMessage m langs MsgCsrfWarning]
|
||||
_ -> res
|
||||
where (Just [t1]) === (Just t2) = TE.encodeUtf8 t1 `constTimeEq` TE.encodeUtf8 t2
|
||||
Nothing === Nothing = True -- ^ It's important to use constTimeEq
|
||||
_ === _ = False -- in order to avoid timing attacks.
|
||||
return ((res', xml), enctype)
|
||||
|
||||
-- | Similar to 'runFormPost', except it always ignore the currently available
|
||||
|
||||
@ -35,6 +35,7 @@ library
|
||||
, blaze-html >= 0.5 && < 0.6
|
||||
, blaze-markup >= 0.5.1 && < 0.6
|
||||
, attoparsec >= 0.10 && < 0.11
|
||||
, crypto-api >= 0.8 && < 0.11
|
||||
|
||||
exposed-modules: Yesod.Form
|
||||
Yesod.Form.Class
|
||||
|
||||
Loading…
Reference in New Issue
Block a user