Simplified SessionBackend

yesod-core/Yesod/Core/Class/Yesod.hs

@@ -202,17 +202,6 @@ $doctype 5
     sessionIpAddress _ = False
     -}
 
-    -- | The path value to set for cookies. By default, uses \"\/\", meaning
-    -- cookies will be sent to every page on the current domain.
-    cookiePath :: a -> S8.ByteString
-    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.
     --
     -- Default: 2 megabytes.
@@ -259,7 +248,7 @@ $doctype 5
     -- | Create a session backend. Returning `Nothing' disables sessions.
     --
     -- Default: Uses clientsession with a 2 hour timeout.
-    makeSessionBackend :: a -> IO (Maybe (SessionBackend a))
+    makeSessionBackend :: a -> IO (Maybe SessionBackend)
     makeSessionBackend _ = fmap Just defaultClientSessionBackend
 
     -- | How to store uploaded files.
@@ -501,7 +490,7 @@ formatLogMessage getdate loc src level msg = do
         , LB ")\n"
         ]
 
-defaultClientSessionBackend :: Yesod master => IO (SessionBackend master)
+defaultClientSessionBackend :: IO SessionBackend
 defaultClientSessionBackend = do
   key <- CS.getKey CS.defaultKeyFile
   let timeout = fromIntegral (120 * 60 :: Int) -- 120 minutes
@@ -522,23 +511,20 @@ right :: Either a b -> Maybe b
 right (Right x) = Just x
 right _ = Nothing
 
-clientSessionBackend :: Yesod master
+clientSessionBackend :: CS.Key  -- ^ The encryption key
-                     => CS.Key  -- ^ The encryption key
                      -> IO ClientSessionDateCache -- ^ See 'clientSessionDateCacher'
-                     -> SessionBackend master
+                     -> SessionBackend
 clientSessionBackend key getCachedDate =
   SessionBackend {
-    sbLoadSession = \master req -> loadClientSession key getCachedDate "_SESSION" master req
+    sbLoadSession = loadClientSession key getCachedDate "_SESSION"
   }
 
-loadClientSession :: Yesod master
+loadClientSession :: CS.Key
-                  => CS.Key
                   -> IO ClientSessionDateCache -- ^ See 'clientSessionDateCacher'
                   -> S8.ByteString -- ^ session name
-                  -> master
                   -> W.Request
                   -> IO (SessionMap, SaveSession)
-loadClientSession key getCachedDate sessionName master req = load
+loadClientSession key getCachedDate sessionName req = load
   where
     load = do
       date <- getCachedDate
@@ -554,9 +540,9 @@ loadClientSession key getCachedDate sessionName master req = load
       return [AddCookie def
           { setCookieName = sessionName
           , setCookieValue = encodeClientSession key iv date host sess'
-          , setCookiePath = Just (cookiePath master)
+          , setCookiePath = Just "/"
           , setCookieExpires = Just (csdcExpires date)
-          , setCookieDomain = cookieDomain master
+          , setCookieDomain = Nothing
           , setCookieHttpOnly = True
           }]
         where

yesod-core/Yesod/Core/Dispatch.hs

@@ -176,7 +176,7 @@ toWaiApp' :: ( Yesod master
              )
           => master
           -> Logger
-          -> Maybe (SessionBackend master)
+          -> Maybe SessionBackend
           -> W.Application
 toWaiApp' y logger sb req =
     case cleanPath y $ W.pathInfo req of

yesod-core/Yesod/Core/Internal/Run.hs

@@ -219,7 +219,7 @@ yesodRunner handler' YesodRunnerEnv {..} req
   | otherwise = do
     let dontSaveSession _ = return []
     (session, saveSession) <- liftIO $ do
-        maybe (return (Map.empty, dontSaveSession)) (\sb -> sbLoadSession sb yreMaster req) yreSessionBackend
+        maybe (return (Map.empty, dontSaveSession)) (\sb -> sbLoadSession sb req) yreSessionBackend
     let mkYesodReq = parseWaiRequest req session (isJust yreSessionBackend) maxLen
     yreq <-
         case mkYesodReq of

yesod-core/Yesod/Core/Types.hs

@@ -60,9 +60,8 @@ type SessionMap = Map Text ByteString
 type SaveSession = SessionMap -- ^ The session contents after running the handler
                 -> IO [Header]
 
-newtype SessionBackend master = SessionBackend
+newtype SessionBackend = SessionBackend
-    { sbLoadSession :: master
+    { sbLoadSession :: W.Request
-                    -> W.Request
                     -> IO (SessionMap, SaveSession) -- ^ Return the session data and a function to save the session
     }
 
@@ -190,7 +189,7 @@ data YesodRunnerEnv sub master = YesodRunnerEnv
     , yreSub            :: !sub
     , yreRoute          :: !(Maybe (Route sub))
     , yreToMaster       :: !(Route sub -> Route master)
-    , yreSessionBackend :: !(Maybe (SessionBackend master))
+    , yreSessionBackend :: !(Maybe SessionBackend)
     }
 
 -- | A generic handler monad, which can have a different subsite and master