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

Harmonize reqCookie and acceptLang.

Browse Source
This commit is contained in:
Björn Buckwalter 2011-09-17 01:19:03 +08:00
parent 09017eb29a
commit 5cec074cfb
1 changed files with 3 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,7 +17,6 @@ import Yesod.Internal
import qualified Network.Wai as W import qualified Network.Wai as W
import System.Random (RandomGen, newStdGen, randomRs) import System.Random (RandomGen, newStdGen, randomRs)
import Web.Cookie (parseCookiesText) import Web.Cookie (parseCookiesText)
import Data.Monoid (mempty)
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Network.HTTP.Types (queryToQueryText) import Network.HTTP.Types (queryToQueryText)
@ -51,9 +50,9 @@ parseWaiRequest' :: RandomGen g
parseWaiRequest' env session' key' gen = Request gets'' cookies' env langs' nonce parseWaiRequest' env session' key' gen = Request gets'' cookies' env langs' nonce
where where
gets' = queryToQueryText $ W.queryString env gets' = queryToQueryText $ W.queryString env
reqCookie = fromMaybe mempty $ lookup "Cookie" gets'' = map (second $ fromMaybe "") gets'
$ W.requestHeaders env reqCookie = lookup "Cookie" $ W.requestHeaders env
cookies' = parseCookiesText reqCookie cookies' = maybe [] parseCookiesText reqCookie
acceptLang = lookup "Accept-Language" $ W.requestHeaders env acceptLang = lookup "Accept-Language" $ W.requestHeaders env
langs = map (pack . S8.unpack) $ maybe [] NWP.parseHttpAccept acceptLang langs = map (pack . S8.unpack) $ maybe [] NWP.parseHttpAccept acceptLang
-- The language preferences are prioritized as follows: -- The language preferences are prioritized as follows:
@ -61,7 +60,6 @@ parseWaiRequest' env session' key' gen = Request gets'' cookies' env langs' nonc
, lookup langKey cookies' -- Cookie _LANG , lookup langKey cookies' -- Cookie _LANG
, lookup langKey session' -- Session _LANG , lookup langKey session' -- Session _LANG
] ++ langs -- Accept-Language(s) ] ++ langs -- Accept-Language(s)
gets'' = map (second $ fromMaybe "") gets'
-- If the session is not secure a nonce should not be -- If the session is not secure a nonce should not be
-- used (any nonce present in the session is ignored). -- used (any nonce present in the session is ignored).
-- If a secure session has no nonceKey a new one is -- If a secure session has no nonceKey a new one is