diff --git a/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai/Internal.hs b/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai/Internal.hs index 56e53e5..5318afa 100644 --- a/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai/Internal.hs +++ b/serversession-frontend-wai/src/Web/ServerSession/Frontend/Wai/Internal.hs @@ -60,7 +60,7 @@ sessionStore state = (sessionMap, saveSessionToken) <- loadSession state mcookieVal sessionRef <- I.newIORef sessionMap let save = do - sessionMap' <- I.readIORef sessionRef + sessionMap' <- I.atomicModifyIORef' sessionRef $ \a -> (a, a) session <- saveSession state saveSessionToken sessionMap' return $ TE.encodeUtf8 $ toPathPiece $ sessionKey session return (mkSession sessionRef, save) @@ -70,7 +70,10 @@ sessionStore state = -- session data. mkSession :: MonadIO m => I.IORef SessionMap -> WS.Session m Text ByteString mkSession sessionRef = - ( \k -> M.lookup k <$> liftIO (I.readIORef sessionRef) + -- We need to use atomicModifyIORef instead of readIORef + -- because latter may be reordered (cf. "Memory Model" on + -- Data.IORef's documentation). + ( \k -> M.lookup k <$> liftIO (I.atomicModifyIORef' sessionRef $ \a -> (a, a)) , \k v -> liftIO (I.atomicModifyIORef' sessionRef $ flip (,) () . M.insert k v) ) diff --git a/serversession/tests/Main.hs b/serversession/tests/Main.hs index 77e48dd..b429963 100644 --- a/serversession/tests/Main.hs +++ b/serversession/tests/Main.hs @@ -286,7 +286,10 @@ instance Storage MockStorage where type TransactionM MockStorage = IO runTransactionM _ = id getSession sto sid = - M.lookup sid <$> I.readIORef (mockSessions sto) + -- We need to use atomicModifyIORef instead of readIORef + -- because latter may be reordered (cf. "Memory Model" on + -- Data.IORef's documentation). + M.lookup sid <$> I.atomicModifyIORef' (mockSessions sto) (\a -> (a, a)) deleteSession sto sid = I.modifyIORef (mockSessions sto) (M.delete sid) deleteAllSessionsOfAuthId sto authId =