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

sessionIpAddress

Browse Source
This commit is contained in:
Michael Snoyman 2010-10-25 12:49:26 +02:00
parent 51943f9a11
commit 05b4d3e9ce
2 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Yesod/Dispatch.hs
View File

@ -225,7 +225,7 @@ toWaiApp' y segments env = do
now <- getCurrentTime now <- getCurrentTime
let getExpires m = fromIntegral (m * 60) `addUTCTime` now let getExpires m = fromIntegral (m * 60) `addUTCTime` now
let exp' = getExpires $ clientSessionDuration y let exp' = getExpires $ clientSessionDuration y
let host = W.remoteHost env let host = if sessionIpAddress y then W.remoteHost env else ""
let session' = fromMaybe [] $ do let session' = fromMaybe [] $ do
raw <- lookup "Cookie" $ W.requestHeaders env raw <- lookup "Cookie" $ W.requestHeaders env
val <- lookup (B.pack sessionName) $ parseCookies raw val <- lookup (B.pack sessionName) $ parseCookies raw

5
Yesod/Yesod.hs
View File

@ -209,6 +209,11 @@ class Eq (Route a) => Yesod a where
-> GHandler sub a (Maybe (Either String (Route a, [(String, String)]))) -> GHandler sub a (Maybe (Either String (Route a, [(String, String)])))
addStaticContent _ _ _ = return Nothing addStaticContent _ _ _ = return Nothing
-- | Whether or not to tie a session to a specific IP address. Defaults to
-- 'True'.
sessionIpAddress :: a -> Bool
sessionIpAddress _ = True
data AuthResult = Authorized | AuthenticationRequired | Unauthorized String data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
deriving (Eq, Show, Read) deriving (Eq, Show, Read)