diff --git a/yesod-core/Yesod/Core/Internal/Session.hs b/yesod-core/Yesod/Core/Internal/Session.hs index dd9ebc61..d255f7ae 100644 --- a/yesod-core/Yesod/Core/Internal/Session.hs +++ b/yesod-core/Yesod/Core/Internal/Session.hs @@ -16,6 +16,7 @@ import Control.Monad (forever, guard) import Yesod.Core.Types import Yesod.Core.Internal.Util import qualified Data.IORef as I +import Control.AutoUpdate encodeClientSession :: CS.Key -> CS.IV @@ -44,25 +45,28 @@ decodeClientSession key date rhost encrypted = do ---------------------------------------------------------------------- --- Mostly copied from Kazu's date-cache, but with modifications --- that better suit our needs. +-- Originally copied from Kazu's date-cache, but now using mkAutoUpdate. -- -- The cached date is updated every 10s, we don't need second -- resolution for session expiration times. +-- +-- The second component of the returned tuple used to be an action that +-- killed the updater thread, but is now a no-op that's just there +-- to preserve the type. clientSessionDateCacher :: NominalDiffTime -- ^ Inactive session valitity. -> IO (IO ClientSessionDateCache, IO ()) clientSessionDateCacher validity = do - ref <- getUpdated >>= I.newIORef - tid <- forkIO $ forever (doUpdate ref) - return $! (I.readIORef ref, killThread tid) + getClientSessionDateCache <- mkAutoUpdate defaultUpdateSettings + { updateAction = getUpdated + , updateFreq = 10000000 -- 10s + } + + return $! (getClientSessionDateCache, return ()) where getUpdated = do now <- getCurrentTime let expires = validity `addUTCTime` now expiresS = runPut (putTime expires) return $! ClientSessionDateCache now expires expiresS - doUpdate ref = do - threadDelay 10000000 -- 10s - I.writeIORef ref =<< getUpdated