From d135958be5d626e3d58c8bf7255a8ce008d9c76d Mon Sep 17 00:00:00 2001 From: Michael Xavier Date: Sat, 12 Mar 2016 13:11:43 -0800 Subject: [PATCH] Update comments, exercise expiration codepath I wanted to at least ensure my change's code was excerised, even though it makes no material difference to the allStorageTests suite. --- .../src/Web/ServerSession/Backend/Redis/Internal.hs | 6 ++++-- serversession-backend-redis/tests/Main.hs | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/serversession-backend-redis/src/Web/ServerSession/Backend/Redis/Internal.hs b/serversession-backend-redis/src/Web/ServerSession/Backend/Redis/Internal.hs index afe2e0b..5ac28d3 100644 --- a/serversession-backend-redis/src/Web/ServerSession/Backend/Redis/Internal.hs +++ b/serversession-backend-redis/src/Web/ServerSession/Backend/Redis/Internal.hs @@ -288,7 +288,6 @@ insertSessionImpl sto session = do let sk = rSessionKey sid r <- batched (R.hmset sk) (printSession session) expireSession session sto - -- Set the expiration if applicable insertSessionForAuthId (sessionKey session) (sessionAuthId session) return (() <$ r) @@ -307,7 +306,6 @@ replaceSessionImpl sto session = do let sk = rSessionKey sid _ <- R.del [sk] r <- batched (R.hmset sk) (printSession session) - -- Set the expiration if applicable expireSession session sto -- Remove the old auth ID from the map if it has changed. @@ -328,6 +326,10 @@ throwRS throwRS = liftIO . E.throwIO +-- | Given a session, finds the next time the session will time out, +-- either by idle or absolute timeout and schedule the key in redis to +-- expire at that time. This is meant to be used on every write to a +-- session so that it is constantly setting the appropriate timeout. expireSession :: Session sess -> RedisStorage sess -> R.RedisTx () expireSession Session {..} RedisStorage {..} = case minimum' (catMaybes [viaIdle, viaAbsolute]) of diff --git a/serversession-backend-redis/tests/Main.hs b/serversession-backend-redis/tests/Main.hs index 761f574..2258c9f 100644 --- a/serversession-backend-redis/tests/Main.hs +++ b/serversession-backend-redis/tests/Main.hs @@ -10,4 +10,4 @@ main :: IO () main = do conn <- connect defaultConnectInfo hspec $ describe "RedisStorage" $ - allStorageTests (RedisStorage conn Nothing Nothing) it runIO parallel shouldBe shouldReturn shouldThrow + allStorageTests (RedisStorage conn (Just 999999) (Just 999999)) it runIO parallel shouldBe shouldReturn shouldThrow