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

Merge pull request #300 from meteficha/cookieDomain

Browse Source 
Session cookie domain
This commit is contained in:
Michael Snoyman 2012-03-21 21:31:06 -07:00
commit f69f0b0cba
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
yesod-core/Yesod/Internal/Core.hs
View File

@ -227,8 +227,8 @@ class RenderRoute a => Yesod a where
where where
corrected = filter (not . T.null) s corrected = filter (not . T.null) s
-- | Builds an absolute URL by concatenating the application root with the -- | Builds an absolute URL by concatenating the application root with the
-- pieces of a path and a query string, if any. -- pieces of a path and a query string, if any.
-- Note that the pieces of the path have been previously cleaned up by 'cleanPath'. -- Note that the pieces of the path have been previously cleaned up by 'cleanPath'.
joinPath :: a joinPath :: a
-> T.Text -- ^ application root -> T.Text -- ^ application root
@ -274,6 +274,12 @@ class RenderRoute a => Yesod a where
cookiePath :: a -> S8.ByteString cookiePath :: a -> S8.ByteString
cookiePath _ = "/" cookiePath _ = "/"
-- | The domain value to set for cookies. By default, the
-- domain is not set, meaning cookies will be sent only to
-- the current domain.
cookieDomain :: a -> Maybe S8.ByteString
cookieDomain _ = Nothing
-- | Maximum allowed length of the request body, in bytes. -- | Maximum allowed length of the request body, in bytes.
maximumContentLength :: a -> Maybe (Route a) -> Int maximumContentLength :: a -> Maybe (Route a) -> Int
maximumContentLength _ _ = 2 * 1024 * 1024 -- 2 megabytes maximumContentLength _ _ = 2 * 1024 * 1024 -- 2 megabytes
@ -368,7 +374,7 @@ formatLogMessage loc level msg = do
-- turn the TH Loc loaction information into a human readable string -- turn the TH Loc loaction information into a human readable string
-- leaving out the loc_end parameter -- leaving out the loc_end parameter
fileLocationToString :: Loc -> String fileLocationToString :: Loc -> String
fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++ fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++
' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc) ' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc)
where where
line = show . fst . loc_start line = show . fst . loc_start
@ -704,7 +710,7 @@ defaultClientSessionBackend = do
let timeout = 120 -- 120 minutes let timeout = 120 -- 120 minutes
return $ clientSessionBackend key timeout return $ clientSessionBackend key timeout
clientSessionBackend :: Yesod master clientSessionBackend :: Yesod master
=> CS.Key -- ^ The encryption key => CS.Key -- ^ The encryption key
-> Int -- ^ Inactive session valitity in minutes -> Int -- ^ Inactive session valitity in minutes
-> SessionBackend master -> SessionBackend master
@ -737,12 +743,12 @@ saveClientSession :: Yesod master
saveClientSession key timeout master _ now _ sess = do saveClientSession key timeout master _ now _ sess = do
-- fixme should we be caching this? -- fixme should we be caching this?
iv <- liftIO $ CS.randomIV iv <- liftIO $ CS.randomIV
return [AddCookie def return [AddCookie def
{ setCookieName = sessionName { setCookieName = sessionName
, setCookieValue = sessionVal iv , setCookieValue = sessionVal iv
, setCookiePath = Just (cookiePath master) , setCookiePath = Just (cookiePath master)
, setCookieExpires = Just expires , setCookieExpires = Just expires
, setCookieDomain = Nothing , setCookieDomain = cookieDomain master
, setCookieHttpOnly = True , setCookieHttpOnly = True
}] }]
where where