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

Clearer language prioritization code.

Browse Source
This commit is contained in:
Björn Buckwalter 2011-09-17 01:02:26 +08:00
parent 33ee15d56f
commit 09017eb29a
1 changed files with 9 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,7 @@ 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)
import Control.Monad (join) import Control.Monad (join)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, catMaybes)
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
-- | The parsed request information. -- | The parsed request information.
@ -48,7 +48,7 @@ parseWaiRequest' :: RandomGen g
-> Maybe a -> Maybe a
-> g -> g
-> Request -> Request
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" reqCookie = fromMaybe mempty $ lookup "Cookie"
@ -56,15 +56,11 @@ parseWaiRequest' env session' key' gen = Request gets'' cookies' env langs''' no
cookies' = parseCookiesText reqCookie cookies' = 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
langs' = case lookup langKey session' of -- The language preferences are prioritized as follows:
Nothing -> langs langs' = catMaybes [ join $ lookup langKey gets' -- Query _LANG
Just x -> x : langs , lookup langKey cookies' -- Cookie _LANG
langs'' = case lookup langKey cookies' of , lookup langKey session' -- Session _LANG
Nothing -> langs' ] ++ langs -- Accept-Language(s)
Just x -> x : langs'
langs''' = case join $ lookup langKey gets' of
Nothing -> langs''
Just x -> x : langs''
gets'' = map (second $ fromMaybe "") gets' 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).
@ -72,8 +68,8 @@ parseWaiRequest' env session' key' gen = Request gets'' cookies' env langs''' no
-- generated. -- generated.
nonce = case (key', lookup nonceKey session') of nonce = case (key', lookup nonceKey session') of
(Nothing, _) -> Nothing (Nothing, _) -> Nothing
(_, Just x) -> Just x (_, Just x) -> Just x
_ -> Just $ pack $ randomString 10 gen _ -> Just $ pack $ randomString 10 gen
-- | Generate a random String of alphanumerical characters -- | Generate a random String of alphanumerical characters
-- (a-z, A-Z, and 0-9) of the given length using the given -- (a-z, A-Z, and 0-9) of the given length using the given