Use AutoUpdate for session expiry date too
This commit is contained in:
parent
6d0affcce7
commit
b9b2d0d609
@ -16,6 +16,7 @@ import Control.Monad (forever, guard)
|
|||||||
import Yesod.Core.Types
|
import Yesod.Core.Types
|
||||||
import Yesod.Core.Internal.Util
|
import Yesod.Core.Internal.Util
|
||||||
import qualified Data.IORef as I
|
import qualified Data.IORef as I
|
||||||
|
import Control.AutoUpdate
|
||||||
|
|
||||||
encodeClientSession :: CS.Key
|
encodeClientSession :: CS.Key
|
||||||
-> CS.IV
|
-> CS.IV
|
||||||
@ -54,15 +55,15 @@ clientSessionDateCacher ::
|
|||||||
NominalDiffTime -- ^ Inactive session valitity.
|
NominalDiffTime -- ^ Inactive session valitity.
|
||||||
-> IO (IO ClientSessionDateCache, IO ())
|
-> IO (IO ClientSessionDateCache, IO ())
|
||||||
clientSessionDateCacher validity = do
|
clientSessionDateCacher validity = do
|
||||||
ref <- getUpdated >>= I.newIORef
|
getClientSessionDateCache <- mkAutoUpdate defaultUpdateSettings
|
||||||
tid <- forkIO $ forever (doUpdate ref)
|
{ updateAction = getUpdated
|
||||||
return $! (I.readIORef ref, killThread tid)
|
, updateFreq = 10000000 -- 10s
|
||||||
|
}
|
||||||
|
|
||||||
|
return $! (getClientSessionDateCache, return ())
|
||||||
where
|
where
|
||||||
getUpdated = do
|
getUpdated = do
|
||||||
now <- getCurrentTime
|
now <- getCurrentTime
|
||||||
let expires = validity `addUTCTime` now
|
let expires = validity `addUTCTime` now
|
||||||
expiresS = runPut (putTime expires)
|
expiresS = runPut (putTime expires)
|
||||||
return $! ClientSessionDateCache now expires expiresS
|
return $! ClientSessionDateCache now expires expiresS
|
||||||
doUpdate ref = do
|
|
||||||
threadDelay 10000000 -- 10s
|
|
||||||
I.writeIORef ref =<< getUpdated
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user