Created
September 16, 2011 15:09
-
-
Save bjornbm/1222324 to your computer and use it in GitHub Desktop.
Test parseWaiRequest nonces and langs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
module Test.InternalRequest where | |
import Data.List (nub) | |
import System.Random (StdGen, mkStdGen) | |
import Blaze.ByteString.Builder | |
import Yesod.Internal.Request | |
import Network.Wai as W | |
import Network.Wai.Test | |
import Web.Cookie (renderCookies) | |
import Test.Hspec | |
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" respectAcceptLangs | |
, it "respects sessions" respectSessionLang | |
, it "respects cookies" respectCookieLang | |
, it "respects queries" respectQueryLang | |
, it "prioritizes correctly" prioritizeLangs | |
] | |
respectAcceptLangs = 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 | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment