diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index 2c9879b9..62e1801b 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -41,6 +41,7 @@ module Yesod.Core , logOtherS -- * Sessions , SessionBackend (..) + , customizeSessionCookies , defaultClientSessionBackend , clientSessionBackend , clientSessionDateCacher diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index ee964a23..1503f94f 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -12,7 +12,7 @@ import Yesod.Routes.Class import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder.Char.Utf8 (fromText) -import Control.Arrow ((***)) +import Control.Arrow ((***), second) import Control.Monad (forM, when, void) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), @@ -235,7 +235,10 @@ class RenderRoute site => Yesod site where jsLoader :: site -> ScriptLoadPosition site jsLoader _ = BottomOfBody - -- | Create a session backend. Returning `Nothing' disables sessions. + -- | Create a session backend. Returning 'Nothing' disables + -- sessions. If you'd like to change the way that the session + -- cookies are created, take a look at + -- 'customizeSessionCookies'. -- -- Default: Uses clientsession with a 2 hour timeout. makeSessionBackend :: site -> IO (Maybe SessionBackend) @@ -532,6 +535,33 @@ formatLogMessage getdate loc src level msg = do , LB ")\n" ] + +-- | Customize the cookies used by the session backend. You may +-- use this function on your definition of 'makeSessionBackend'. +-- +-- For example, you could set the cookie domain so that it +-- would work across many subdomains: +-- +-- @ +-- makeSessionBackend = fmap (customizeSessionCookie addDomain) ... +-- where +-- addDomain cookie = cookie { 'setCookieDomain' = Just \".example.com\" } +-- @ +-- +-- Default: Do not customize anything ('id'). +customizeSessionCookies :: (SetCookie -> SetCookie) -> (SessionBackend -> SessionBackend) +customizeSessionCookies customizeCookie backend = backend' + where + customizeHeader (AddCookie cookie) = AddCookie (customizeCookie cookie) + customizeHeader other = other + customizeSaveSession = (fmap . fmap . fmap) customizeHeader + backend' = + backend { + sbLoadSession = \req -> + second customizeSaveSession `fmap` sbLoadSession backend req + } + + defaultClientSessionBackend :: Int -- ^ minutes -> FilePath -- ^ key file -> IO SessionBackend diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index f7847a13..44fd0ba6 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.2.0.2 +version: 1.2.0.3 license: MIT license-file: LICENSE author: Michael Snoyman