diff --git a/yesod-core/Yesod/Internal/Request.hs b/yesod-core/Yesod/Internal/Request.hs index 43040b45..49c3be18 100644 --- a/yesod-core/Yesod/Internal/Request.hs +++ b/yesod-core/Yesod/Internal/Request.hs @@ -1,9 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module Yesod.Internal.Request ( parseWaiRequest , Request (..) , RequestBodyContents , FileInfo (..) +#ifdef TEST + , randomString + , parseWaiRequest' +#endif ) where import Control.Applicative ((<$>)) diff --git a/yesod-core/test/Test/InternalRequest.hs b/yesod-core/test/Test/InternalRequest.hs new file mode 100644 index 00000000..215d467a --- /dev/null +++ b/yesod-core/test/Test/InternalRequest.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE OverloadedStrings #-} +module Test.InternalRequest where + +import Data.List (nub) +import System.Random (StdGen, mkStdGen) +import Control.Applicative ((<$>)) + +import Blaze.ByteString.Builder + +import Yesod.Internal.Request +import Network.Wai as W +import Network.Wai.Test +import Web.Cookie (renderCookies) +import Test.Hspec +import Test.Hspec.HUnit + + +randomStringSpecs :: [Spec] +randomStringSpecs = describe "Yesod.Internal.Request.randomString" + [ it "does not repeat itself" $ noRepeat 10 100 + ] + +noRepeat len n = length (nub $ map (randomString len . mkStdGen) [1..n]) == n + + +-- For convenience instead of "(undefined :: StdGen)". +g :: StdGen +g = undefined + + +nonceSpecs :: [Spec] +nonceSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqNonce)" + [ it "is Nothing for unsecure sessions" noUnsecureNonce + , it "ignores pre-existing nonce for unsecure sessions" ignoreUnsecureNonce + , it "uses preexisting nonce for secure sessions" useOldNonce + , it "generates a new nonce for secure sessions without nonce" generateNonce + ] + +noUnsecureNonce = reqNonce r == Nothing where + r = parseWaiRequest' defaultRequest [] Nothing g + +ignoreUnsecureNonce = reqNonce r == Nothing where + r = parseWaiRequest' defaultRequest [("_NONCE", "old")] Nothing g + +useOldNonce = reqNonce r == Just "old" where + r = parseWaiRequest' defaultRequest [("_NONCE", "old")] (Just undefined) g + +generateNonce = reqNonce r /= Nothing where + r = parseWaiRequest' defaultRequest [("_NONCE", "old")] (Just undefined) g + + +langSpecs :: [Spec] +langSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqLangs)" + [ it "respects Accept-Language" respectAcceptLang + , it "respects sessions" respectSessionLang + , it "respects cookies" respectCookieLang + , it "respects queries" respectQueryLang + , it "prioritizes correctly" prioritizeLangs + ] + +respectAcceptLang = reqLangs r == ["accept1", "accept2"] where + r = parseWaiRequest' defaultRequest + { requestHeaders = [("Accept-Language", "accept1, accept2")] } [] Nothing g + +respectSessionLang = reqLangs r == ["session"] where + r = parseWaiRequest' defaultRequest [("_LANG", "session")] Nothing g + +respectCookieLang = reqLangs r == ["cookie"] where + r = parseWaiRequest' defaultRequest + { requestHeaders = [("Cookie", toByteString $ renderCookies [("_LANG", "cookie")])] + } [] Nothing g + +respectQueryLang = reqLangs r == ["query"] where + r = parseWaiRequest' defaultRequest { queryString = [("_LANG", Just "query")] } [] Nothing g + +prioritizeLangs = reqLangs r == ["query", "cookie", "session", "accept1", "accept2"] where + r = parseWaiRequest' defaultRequest + { requestHeaders = [ ("Accept-Language", "accept1, accept2") + , ("Cookie", toByteString $ renderCookies [("_LANG", "cookie")]) + ] + , queryString = [("_LANG", Just "query")] + } [("_LANG", "session")] Nothing g + + +internalRequestTest :: [Spec] +internalRequestTest = descriptions [ randomStringSpecs + , nonceSpecs + , langSpecs + ]