Removed enableClientSessions
This commit is contained in:
parent
aa8a4e9c25
commit
0c946de756
@ -96,15 +96,9 @@ class Eq (Route a) => Yesod a where
|
|||||||
approot :: a -> String
|
approot :: a -> String
|
||||||
|
|
||||||
-- | The encryption key to be used for encrypting client sessions.
|
-- | The encryption key to be used for encrypting client sessions.
|
||||||
encryptKey :: a -> IO CS.Key
|
-- Returning 'Nothing' disables sessions.
|
||||||
encryptKey _ = getKey defaultKeyFile
|
encryptKey :: a -> IO (Maybe CS.Key)
|
||||||
|
encryptKey _ = fmap Just $ getKey defaultKeyFile
|
||||||
-- | Whether or not to use client sessions.
|
|
||||||
--
|
|
||||||
-- FIXME: A better API would be to have 'encryptKey' return a Maybe, but
|
|
||||||
-- that would be a breaking change. Please include in Yesod 0.7.
|
|
||||||
enableClientSessions :: a -> Bool
|
|
||||||
enableClientSessions _ = True
|
|
||||||
|
|
||||||
-- | Number of minutes before a client session times out. Defaults to
|
-- | Number of minutes before a client session times out. Defaults to
|
||||||
-- 120 (2 hours).
|
-- 120 (2 hours).
|
||||||
|
|||||||
@ -242,9 +242,7 @@ toWaiApp y = do
|
|||||||
-- middleware.
|
-- middleware.
|
||||||
toWaiAppPlain :: (Yesod y, YesodSite y) => y -> IO W.Application
|
toWaiAppPlain :: (Yesod y, YesodSite y) => y -> IO W.Application
|
||||||
toWaiAppPlain a = do
|
toWaiAppPlain a = do
|
||||||
key' <- if enableClientSessions a
|
key' <- encryptKey a
|
||||||
then Just `fmap` encryptKey a
|
|
||||||
else return Nothing
|
|
||||||
return $ cleanPath (splitPath a) (B.pack $ approot a)
|
return $ cleanPath (splitPath a) (B.pack $ approot a)
|
||||||
$ toWaiApp' a key'
|
$ toWaiApp' a key'
|
||||||
|
|
||||||
@ -277,7 +275,7 @@ toWaiApp' y key' segments env = do
|
|||||||
(joinPath y (approot y) ps $ qs ++ qs')
|
(joinPath y (approot y) ps $ qs ++ qs')
|
||||||
(urlRenderOverride y u)
|
(urlRenderOverride y u)
|
||||||
let errorHandler' = localNoCurrent . errorHandler
|
let errorHandler' = localNoCurrent . errorHandler
|
||||||
rr <- parseWaiRequest env session'
|
rr <- parseWaiRequest env session' key'
|
||||||
let h = do
|
let h = do
|
||||||
onRequest
|
onRequest
|
||||||
case eurl of
|
case eurl of
|
||||||
@ -347,8 +345,9 @@ httpAccept = map B.unpack
|
|||||||
|
|
||||||
parseWaiRequest :: W.Request
|
parseWaiRequest :: W.Request
|
||||||
-> [(String, String)] -- ^ session
|
-> [(String, String)] -- ^ session
|
||||||
|
-> Maybe a
|
||||||
-> IO Request
|
-> IO Request
|
||||||
parseWaiRequest env session' = do
|
parseWaiRequest env session' key' = do
|
||||||
let gets' = map (bsToChars *** bsToChars)
|
let gets' = map (bsToChars *** bsToChars)
|
||||||
$ parseQueryString $ W.queryString env
|
$ parseQueryString $ W.queryString env
|
||||||
let reqCookie = fromMaybe B.empty $ lookup "Cookie"
|
let reqCookie = fromMaybe B.empty $ lookup "Cookie"
|
||||||
@ -366,9 +365,10 @@ parseWaiRequest env session' = do
|
|||||||
Nothing -> langs''
|
Nothing -> langs''
|
||||||
Just x -> x : langs''
|
Just x -> x : langs''
|
||||||
rbthunk <- iothunk $ rbHelper env
|
rbthunk <- iothunk $ rbHelper env
|
||||||
nonce <- case lookup nonceKey session' of
|
nonce <- case (key', lookup nonceKey session') of
|
||||||
Just x -> return x
|
(Nothing, _) -> return $ error "You have attempted to use the nonce, but sessions are disabled." -- FIXME maybe this should be handled without an error?
|
||||||
Nothing -> do
|
(_, Just x) -> return x
|
||||||
|
(_, Nothing) -> do
|
||||||
g <- newStdGen
|
g <- newStdGen
|
||||||
return $ fst $ randomString 10 g
|
return $ fst $ randomString 10 g
|
||||||
return $ Request gets' cookies' rbthunk env langs''' nonce
|
return $ Request gets' cookies' rbthunk env langs''' nonce
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user