Make Felipe's session code the default (#415)

yesod-core/Yesod/Core.hs

@@ -35,7 +35,6 @@ module Yesod.Core
     , SessionBackend (..)
     , defaultClientSessionBackend
     , clientSessionBackend
-    , clientSessionBackend2
     , clientSessionDateCacher
     , loadClientSession
     , Header(..)

yesod-core/Yesod/Internal/Core.hs

@@ -26,8 +26,6 @@ module Yesod.Internal.Core
     , defaultClientSessionBackend
     , clientSessionBackend
     , loadClientSession
-    , clientSessionBackend2
-    , loadClientSession2
     , clientSessionDateCacher
     , BackendSession
       -- * jsLoader
@@ -48,7 +46,6 @@ import Yesod.Handler hiding (lift, getExpires)
 import Control.Monad.Logger (logErrorS)
 
 import Yesod.Routes.Class
-import Data.Time (UTCTime, addUTCTime, getCurrentTime)
 
 import Data.Word (Word64)
 import Control.Arrow ((***))
@@ -435,10 +432,9 @@ defaultYesodRunner :: Yesod master
 defaultYesodRunner logger handler' master sub murl toMasterRoute msb req
   | W.KnownLength len <- W.requestBodyLength req, maxLen < len = return tooLargeResponse
   | otherwise = do
-    let dontSaveSession _ _ = return []
+    let dontSaveSession _ = return []
-    now <- liftIO getCurrentTime -- FIXME remove in next major version bump
     (session, saveSession) <- liftIO $ do
-        maybe (return ([], dontSaveSession)) (\sb -> sbLoadSession sb master req now) msb
+        maybe (return ([], dontSaveSession)) (\sb -> sbLoadSession sb master req) msb
     rr <- liftIO $ parseWaiRequest req session (isJust msb) maxLen
     let h = {-# SCC "h" #-} do
           case murl of
@@ -468,7 +464,7 @@ defaultYesodRunner logger handler' master sub murl toMasterRoute msb req
                     newSess
                     (\n -> Map.insert tokenKey (TE.encodeUtf8 n) newSess)
                     (reqToken rr)
-            sessionHeaders <- liftIO (saveSession nsToken now)
+            sessionHeaders <- liftIO (saveSession nsToken)
             return $ ("Content-Type", ct) : map headerToPair sessionHeaders
         _ -> return []
     return $ yarToResponse yar extraHeaders
@@ -755,67 +751,25 @@ defaultClientSessionBackend = do
   key <- CS.getKey CS.defaultKeyFile
   let timeout = fromIntegral (120 * 60 :: Int) -- 120 minutes
   (getCachedDate, _closeDateCacher) <- clientSessionDateCacher timeout
-  return $ clientSessionBackend2 key getCachedDate
+  return $ clientSessionBackend key getCachedDate
-
 
 clientSessionBackend :: Yesod master
-                     => CS.Key  -- ^ The encryption key
-                     -> Int -- ^ Inactive session valitity in minutes
-                     -> SessionBackend master
-clientSessionBackend key timeout = SessionBackend
-    { sbLoadSession = loadClientSession key timeout "_SESSION"
-    }
-{-# DEPRECATED clientSessionBackend "Please use clientSessionBackend2, which is more efficient." #-}
-
-loadClientSession :: Yesod master
-                  => CS.Key
-                  -> Int -- ^ timeout
-                  -> S8.ByteString -- ^ session name
-                  -> master
-                  -> W.Request
-                  -> UTCTime
-                  -> IO (BackendSession, SaveSession)
-loadClientSession key timeout sessionName master req now = return (sess, save)
-  where
-    sess = fromMaybe [] $ do
-      raw <- lookup "Cookie" $ W.requestHeaders req
-      val <- lookup sessionName $ parseCookies raw
-      let host = "" -- fixme, properly lock sessions to client address
-      decodeClientSessionOld key now host val
-    save sess' now' = do
-      -- We should never cache the IV!  Be careful!
-      iv <- liftIO CS.randomIV
-      return [AddCookie def
-          { setCookieName = sessionName
-          , setCookieValue = sessionVal iv
-          , setCookiePath = Just (cookiePath master)
-          , setCookieExpires = Just expires
-          , setCookieDomain = cookieDomain master
-          , setCookieHttpOnly = True
-          }]
-        where
-          host = "" -- fixme, properly lock sessions to client address
-          expires = fromIntegral (timeout * 60) `addUTCTime` now'
-          sessionVal iv = encodeClientSessionOld key iv expires host sess'
-{-# DEPRECATED loadClientSession "Please use loadClientSession2, which is more efficient." #-}
-
-clientSessionBackend2 :: Yesod master
                      => CS.Key  -- ^ The encryption key
                      -> IO ClientSessionDateCache -- ^ See 'clientSessionDateCacher'
                      -> SessionBackend master
-clientSessionBackend2 key getCachedDate =
+clientSessionBackend key getCachedDate =
   SessionBackend {
-    sbLoadSession = \master req -> const $ loadClientSession2 key getCachedDate "_SESSION" master req
+    sbLoadSession = \master req -> loadClientSession key getCachedDate "_SESSION" master req
   }
 
-loadClientSession2 :: Yesod master
+loadClientSession :: Yesod master
                   => CS.Key
                   -> IO ClientSessionDateCache -- ^ See 'clientSessionDateCacher'
                   -> S8.ByteString -- ^ session name
                   -> master
                   -> W.Request
                   -> IO (BackendSession, SaveSession)
-loadClientSession2 key getCachedDate sessionName master req = load
+loadClientSession key getCachedDate sessionName master req = load
   where
     load = do
       date <- getCachedDate
@@ -825,7 +779,7 @@ loadClientSession2 key getCachedDate sessionName master req = load
       val <- lookup sessionName $ parseCookies raw
       let host = "" -- fixme, properly lock sessions to client address
       decodeClientSession key date host val
-    save date sess' _ = do
+    save date sess' = do
       -- We should never cache the IV!  Be careful!
       iv <- liftIO CS.randomIV
       return [AddCookie def

yesod-core/Yesod/Internal/Session.hs

@@ -1,13 +1,10 @@
 module Yesod.Internal.Session
     ( encodeClientSession
-    , encodeClientSessionOld
     , decodeClientSession
-    , decodeClientSessionOld
     , clientSessionDateCacher
     , ClientSessionDateCache(..)
     , BackendSession
     , SaveSession
-    , SaveSessionOld
     , SessionBackend(..)
     ) where
 
@@ -30,17 +27,11 @@ import qualified Network.Wai as W
 type BackendSession = [(Text, S8.ByteString)]
 
 type SaveSession = BackendSession    -- ^ The session contents after running the handler
-                -> UTCTime -- FIXME remove this in the next major version bump
-                -> IO [Header]
-
-type SaveSessionOld = BackendSession    -- ^ The session contents after running the handler
-                -> UTCTime
                 -> IO [Header]
 
 newtype SessionBackend master = SessionBackend
     { sbLoadSession :: master
                     -> W.Request
-                    -> UTCTime -- FIXME remove this in the next major version bump
                     -> IO (BackendSession, SaveSession) -- ^ Return the session data and a function to save the session
     }
 
@@ -137,25 +128,3 @@ posixDayLength_int64 = 86400
 
 diffTimeScale :: DiffTime
 diffTimeScale = 1e12
-
-encodeClientSessionOld :: CS.Key
-                    -> CS.IV
-                    -> UTCTime -- ^ expire time
-                    -> ByteString -- ^ remote host
-                    -> [(Text, ByteString)] -- ^ session
-                    -> ByteString -- ^ cookie value
-encodeClientSessionOld key iv expire rhost session' =
-    CS.encrypt key iv $ encode $ SessionCookie (Left expire) rhost session'
-
-decodeClientSessionOld :: CS.Key
-                    -> UTCTime -- ^ current time
-                    -> ByteString -- ^ remote host field
-                    -> ByteString -- ^ cookie value
-                    -> Maybe [(Text, ByteString)]
-decodeClientSessionOld key now rhost encrypted = do
-    decrypted <- CS.decrypt key encrypted
-    SessionCookie (Left expire) rhost' session' <-
-        either (const Nothing) Just $ decode decrypted
-    guard $ expire > now
-    guard $ rhost' == rhost
-    return session'