haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

nonce -> token (#214)

Browse Source
This commit is contained in:
Michael Snoyman 2012-03-16 06:39:30 +02:00
parent f11656f73a
commit ec62f6f68c
12 changed files with 56 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
yesod-core/Yesod/Internal.hs
View File

@ -25,7 +25,7 @@ module Yesod.Internal
, toUnique
-- * Names
, sessionName
, nonceKey
, tokenKey
) where
import Text.Hamlet (HtmlUrl, hamlet, Html)
@ -95,8 +95,8 @@ newtype Head url = Head (HtmlUrl url)
newtype Body url = Body (HtmlUrl url)
deriving Monoid
nonceKey :: IsString a => a
nonceKey = "_NONCE"
tokenKey :: IsString a => a
tokenKey = "_TOKEN"
sessionName :: IsString a => a
sessionName = "_SESSION"

10
yesod-core/Yesod/Internal/Core.hs
View File

@ -416,19 +416,19 @@ defaultYesodRunner handler master sub murl toMasterRoute msb req = do
redirect url'
Unauthorized s' -> permissionDenied s'
handler
let sessionMap = Map.fromList . filter ((/=) nonceKey . fst) $ session
let sessionMap = Map.fromList . filter ((/=) tokenKey . fst) $ session
let ra = resolveApproot master req
yar <- handlerToYAR master sub toMasterRoute
(yesodRender master ra) errorHandler rr murl sessionMap h
extraHeaders <- case yar of
(YARPlain _ _ ct _ newSess) -> do
let nsNonce = Map.toList $ maybe
let nsToken = Map.toList $ maybe
newSess
(\n -> Map.insert nonceKey (TE.encodeUtf8 n) newSess)
(reqNonce rr)
(\n -> Map.insert tokenKey (TE.encodeUtf8 n) newSess)
(reqToken rr)
sessionHeaders <- liftIO $ maybe
(return [])
(\sb -> sbSaveSession sb master req now session nsNonce)
(\sb -> sbSaveSession sb master req now session nsToken)
msb
return $ ("Content-Type", ct) : map headerToPair sessionHeaders
_ -> return []

22
yesod-core/Yesod/Internal/Request.hs
View File

@ -36,16 +36,16 @@ data Request = Request
, reqWaiRequest :: W.Request
-- | Languages which the client supports.
, reqLangs :: [Text]
-- | A random, session-specific nonce used to prevent CSRF attacks.
, reqNonce :: Maybe Text
-- | A random, session-specific token used to prevent CSRF attacks.
, reqToken :: Maybe Text
}
parseWaiRequest :: W.Request
-> [(Text, ByteString)] -- ^ session
-> Bool
-> IO Request
parseWaiRequest env session' useNonce =
parseWaiRequest' env session' useNonce <$> newStdGen
parseWaiRequest env session' useToken =
parseWaiRequest' env session' useToken <$> newStdGen
parseWaiRequest' :: RandomGen g
=> W.Request
@ -53,8 +53,8 @@ parseWaiRequest' :: RandomGen g
-> Bool
-> g
-> Request
parseWaiRequest' env session' useNonce gen =
Request gets'' cookies' env langs'' nonce
parseWaiRequest' env session' useToken gen =
Request gets'' cookies' env langs'' token
where
gets' = queryToQueryText $ W.queryString env
gets'' = map (second $ fromMaybe "") gets'
@ -75,16 +75,16 @@ parseWaiRequest' env session' useNonce gen =
-- language in the list.
langs'' = addTwoLetters (id, Set.empty) langs'
-- If sessions are disabled nonces should not be used (any
-- nonceKey present in the session is ignored). If sessions
-- are enabled and a session has no nonceKey a new one is
-- If sessions are disabled tokens should not be used (any
-- tokenKey present in the session is ignored). If sessions
-- are enabled and a session has no tokenKey a new one is
-- generated.
nonce = if not useNonce
token = if not useToken
then Nothing
else Just $ maybe
(pack $ randomString 10 gen)
(decodeUtf8With lenientDecode)
(lookup nonceKey session')
(lookup tokenKey session')
addTwoLetters :: ([Text] -> [Text], Set.Set Text) -> [Text] -> [Text]
addTwoLetters (toAdd, exist) [] =

38
yesod-core/test/YesodCoreTest/InternalRequest.hs
View File

@ -27,32 +27,32 @@ noRepeat len n = length (nub $ map (randomString len . mkStdGen) [1..n]) == n
-- For convenience instead of "(undefined :: StdGen)".
g :: StdGen
g = undefined
g = error "test/YesodCoreTest/InternalRequest.g"
nonceSpecs :: [Spec]
nonceSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqNonce)"
[ it "is Nothing if sessions are disabled" noDisabledNonce
, it "ignores pre-existing nonce if sessions are disabled" ignoreDisabledNonce
, it "uses preexisting nonce in session" useOldNonce
, it "generates a new nonce for sessions without nonce" generateNonce
tokenSpecs :: [Spec]
tokenSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqToken)"
[ it "is Nothing if sessions are disabled" noDisabledToken
, it "ignores pre-existing token if sessions are disabled" ignoreDisabledToken
, it "uses preexisting token in session" useOldToken
, it "generates a new token for sessions without token" generateToken
]
noDisabledNonce :: Bool
noDisabledNonce = reqNonce r == Nothing where
noDisabledToken :: Bool
noDisabledToken = reqToken r == Nothing where
r = parseWaiRequest' defaultRequest [] False g
ignoreDisabledNonce :: Bool
ignoreDisabledNonce = reqNonce r == Nothing where
r = parseWaiRequest' defaultRequest [("_NONCE", "old")] False g
ignoreDisabledToken :: Bool
ignoreDisabledToken = reqToken r == Nothing where
r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] False g
useOldNonce :: Bool
useOldNonce = reqNonce r == Just "old" where
r = parseWaiRequest' defaultRequest [("_NONCE", "old")] True g
useOldToken :: Bool
useOldToken = reqToken r == Just "old" where
r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] True g
generateNonce :: Bool
generateNonce = reqNonce r /= Nothing where
r = parseWaiRequest' defaultRequest [("_NONCE", "old")] True g
generateToken :: Bool
generateToken = reqToken r /= Nothing where
r = parseWaiRequest' defaultRequest [("_TOKEN", "old")] True g
langSpecs :: [Spec]
@ -95,6 +95,6 @@ prioritizeLangs = reqLangs r == ["en-QUERY", "en-COOKIE", "en-SESSION", "en", "e
internalRequestTest :: [Spec]
internalRequestTest = descriptions [ randomStringSpecs
, nonceSpecs
, tokenSpecs
, langSpecs
]

2
yesod-core/test/YesodCoreTest/JsLoader.hs
View File

@ -1,7 +1,7 @@
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module YesodCoreTest.JsLoader (specs) where
module YesodCoreTest.JsLoader (specs, Widget) where
import YesodCoreTest.JsLoaderSites.HeadAsync (HA(..))
import YesodCoreTest.JsLoaderSites.Bottom (B(..))

2
yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs
View File

@ -1,7 +1,7 @@
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module YesodCoreTest.JsLoaderSites.Bottom (B(..)) where
module YesodCoreTest.JsLoaderSites.Bottom (B(..), Widget) where
import Yesod.Core

2
yesod-core/test/YesodCoreTest/JsLoaderSites/HeadAsync.hs
View File

@ -1,7 +1,7 @@
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module YesodCoreTest.JsLoaderSites.HeadAsync (HA(..)) where
module YesodCoreTest.JsLoaderSites.HeadAsync (HA(..), Widget) where
import Yesod.Core

2
yesod-core/test/YesodCoreTest/Links.hs
View File

@ -18,7 +18,7 @@ mkYesod "Y" [parseRoutes|
instance Yesod Y
getRootR :: Handler RepHtml
getRootR = defaultLayout $ addHamlet [hamlet|<a href=@{RootR}>|]
getRootR = defaultLayout $ toWidget [hamlet|<a href=@{RootR}>|]
linksTest :: [Spec]
linksTest = describe "Test.Links"

4
yesod-core/test/YesodCoreTest/Media.hs
View File

@ -27,9 +27,9 @@ instance Yesod Y where
getRootR :: Handler RepHtml
getRootR = defaultLayout $ do
addCassius [lucius|foo1{bar:baz}|]
toWidget [lucius|foo1{bar:baz}|]
addCassiusMedia "screen" [lucius|foo2{bar:baz}|]
addCassius [lucius|foo3{bar:baz}|]
toWidget [lucius|foo3{bar:baz}|]
getStaticR :: Handler RepHtml
getStaticR = getRootR

2
yesod-core/yesod-core.cabal
View File

@ -1,5 +1,5 @@
name: yesod-core
version: 1.0.0
version: 1.0.0.20120316
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>

20
yesod-form/Yesod/Form/Functions.hs
View File

@ -18,7 +18,7 @@ module Yesod.Form.Functions
, aopt
-- * Run a form
, runFormPost
, runFormPostNoNonce
, runFormPostNoToken
, runFormGet
-- * Generate a blank form
, generateFormPost
@ -48,7 +48,7 @@ import Text.Blaze (Html, toHtml)
import Yesod.Handler (GHandler, getRequest, runRequestBody, newIdent, getYesod)
import Yesod.Core (RenderMessage, SomeMessage (..))
import Yesod.Widget (GWidget, whamlet)
import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams, languages, FileInfo (..))
import Yesod.Request (reqToken, reqWaiRequest, reqGetParams, languages, FileInfo (..))
import Network.Wai (requestMethod)
import Text.Hamlet (shamlet)
import Data.Monoid (mempty)
@ -178,18 +178,18 @@ postHelper :: RenderMessage master FormMessage
-> GHandler sub master ((FormResult a, xml), Enctype)
postHelper form env = do
req <- getRequest
let nonceKey = "_nonce"
let nonce =
case reqNonce req of
let tokenKey = "_token"
let token =
case reqToken req of
Nothing -> mempty
Just n -> [shamlet|<input type=hidden name=#{nonceKey} value=#{n}>|]
Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]
m <- getYesod
langs <- languages
((res, xml), enctype) <- runFormGeneric (form nonce) m langs env
((res, xml), enctype) <- runFormGeneric (form token) m langs env
let res' =
case (res, env) of
(FormSuccess{}, Just (params, _))
| Map.lookup nonceKey params /= fmap return (reqNonce req) ->
| Map.lookup tokenKey params /= fmap return (reqToken req) ->
FormFailure [renderMessage m langs MsgCsrfWarning]
_ -> res
return ((res', xml), enctype)
@ -216,8 +216,8 @@ postEnv = do
where
notEmpty = not . L.null . fileContent
runFormPostNoNonce :: (Html -> MForm sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
runFormPostNoNonce form = do
runFormPostNoToken :: (Html -> MForm sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
runFormPostNoToken form = do
langs <- languages
m <- getYesod
env <- postEnv

2
yesod-form/yesod-form.cabal
View File

@ -1,5 +1,5 @@
name: yesod-form
version: 1.0.0
version: 1.0.0.20120316
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>