haskell/serversession
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Stricter test for deleteAllSessionsOfAuthId.

Browse Source
This commit is contained in:
Felipe Lessa 2015-05-28 01:33:37 -03:00
parent 9d33cb07aa
commit cebcea5bde
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
serversession/src/Web/ServerSession/Core/StorageTests.hs
View File

@ -84,13 +84,19 @@ allStorageTests storage it runIO _shouldBe shouldReturn shouldThrow = do
it "deleteAllSessionsOfAuthId should delete the relevant sessions (but no more)" $ do it "deleteAllSessionsOfAuthId should delete the relevant sessions (but no more)" $ do
replicateM_ 20 $ do replicateM_ 20 $ do
master <- generateSession gen HasAuthId master <- generateSession gen HasAuthId
let Just authId = sessionAuthId master let Just authId = sessionAuthId master
slaves <- (map $ \s -> s { sessionAuthId = Just authId }) <$> preslaves <- replicateM 200 (generateSession gen NoAuthId)
replicateM 200 (generateSession gen NoAuthId) let slaves = (\s -> s { sessionAuthId = Just authId }) <$> preslaves
others <- (++) <$> replicateM 30 (generateSession gen HasAuthId) others <- (++) <$> replicateM 30 (generateSession gen HasAuthId)
<*> replicateM 30 (generateSession gen NoAuthId) <*> replicateM 30 (generateSession gen NoAuthId)
let allS = master : slaves ++ others let allS = master : slaves ++ others
run (mapM_ (insertSession storage) allS)
-- Insert preslaves then replace them with slaves to
-- further test if the storage backend is able to maintain
-- its invariants regarding auth IDs.
run (mapM_ (insertSession storage) (master : preslaves ++ others))
run (mapM_ (replaceSession storage) slaves)
run (mapM (getSession storage . sessionKey) allS) `shouldReturn` (Just <$> allS) run (mapM (getSession storage . sessionKey) allS) `shouldReturn` (Just <$> allS)
run (deleteAllSessionsOfAuthId storage authId) run (deleteAllSessionsOfAuthId storage authId)
run (mapM (getSession storage . sessionKey) allS) `shouldReturn` run (mapM (getSession storage . sessionKey) allS) `shouldReturn`