wai-session-postgresql 0.2.1.2 → 0.2.1.3
raw patch · 4 files changed
+47/−55 lines, 4 filesdep +hspec
Dependencies added: hspec
Files
- changelog.md +7/−0
- src/Network/Wai/Session/PostgreSQL.hs +11/−25
- test/Spec.hs +27/−29
- wai-session-postgresql.cabal +2/−1
changelog.md view
@@ -1,3 +1,10 @@+0.2.1.3 / 2020-09-25+--------------------++Two changes by Simon Hengel/@sol+- Fix a concurrency bug+- Cleanups / proper test suite declarations+ 0.2.1.2 / 2017-11-26 --------------------
src/Network/Wai/Session/PostgreSQL.hs view
@@ -116,25 +116,19 @@ withPostgreSQLConn = withResource qryCreateTable1 :: Query-qryCreateTable1 = "CREATE TABLE wai_pg_sessions (id bigserial NOT NULL, session_key character varying NOT NULL, session_created_at bigint NOT NULL, session_last_access bigint NOT NULL, session_invalidate_key boolean NOT NULL DEFAULT false, CONSTRAINT wai_pg_sessions_pkey PRIMARY KEY (id), CONSTRAINT wai_pg_sessions_session_key UNIQUE (session_key)) WITH ( OIDS=FALSE );"+qryCreateTable1 = "CREATE TABLE IF NOT EXISTS wai_pg_sessions (id bigserial NOT NULL, session_key character varying NOT NULL, session_created_at bigint NOT NULL, session_last_access bigint NOT NULL, session_invalidate_key boolean NOT NULL DEFAULT false, CONSTRAINT wai_pg_sessions_pkey PRIMARY KEY (id), CONSTRAINT wai_pg_sessions_session_key UNIQUE (session_key)) WITH ( OIDS=FALSE );" qryCreateIndex1 :: Query-qryCreateIndex1 = "CREATE INDEX idx_session_last_access ON public.wai_pg_sessions USING btree (session_last_access);"+qryCreateIndex1 = "CREATE INDEX IF NOT EXISTS idx_session_last_access ON public.wai_pg_sessions USING btree (session_last_access);" qryCreateTable2 :: Query-qryCreateTable2 = "CREATE TABLE wai_pg_session_data ( id bigserial NOT NULL, wai_pg_session bigint, key bytea, value bytea, CONSTRAINT wai_pg_session_data_pkey PRIMARY KEY (id), CONSTRAINT wai_pg_session_data_wai_pg_session_fkey FOREIGN KEY (wai_pg_session) REFERENCES wai_pg_sessions (id) MATCH SIMPLE ON UPDATE RESTRICT ON DELETE CASCADE, CONSTRAINT wai_pg_session_data_wai_pg_session_key_key UNIQUE (wai_pg_session, key) ) WITH (OIDS=FALSE);"+qryCreateTable2 = "CREATE TABLE IF NOT EXISTS wai_pg_session_data ( id bigserial NOT NULL, wai_pg_session bigint, key bytea, value bytea, CONSTRAINT wai_pg_session_data_pkey PRIMARY KEY (id), CONSTRAINT wai_pg_session_data_wai_pg_session_fkey FOREIGN KEY (wai_pg_session) REFERENCES wai_pg_sessions (id) MATCH SIMPLE ON UPDATE RESTRICT ON DELETE CASCADE, CONSTRAINT wai_pg_session_data_wai_pg_session_key_key UNIQUE (wai_pg_session, key) ) WITH (OIDS=FALSE);" qryCreateSession :: Query qryCreateSession = "INSERT INTO wai_pg_sessions (session_key, session_created_at, session_last_access) VALUES (?,?,?) RETURNING id" -qryCreateSessionEntry :: Query-qryCreateSessionEntry = "INSERT INTO wai_pg_session_data (wai_pg_session,key,value) VALUES (?,?,?)"--qryUpdateSession :: Query-qryUpdateSession = "UPDATE wai_pg_sessions SET session_last_access=? WHERE id=?"--qryUpdateSessionEntry :: Query-qryUpdateSessionEntry = "UPDATE wai_pg_session_data SET value=? WHERE wai_pg_session=? AND key=?"+qryCreateOrUpdateSessionEntry :: Query+qryCreateOrUpdateSessionEntry = "INSERT INTO wai_pg_session_data (wai_pg_session,key,value) VALUES (?,?,?) ON CONFLICT (wai_pg_session,key) DO UPDATE SET value=EXCLUDED.value" qryLookupSession :: Query qryLookupSession = "SELECT id FROM wai_pg_sessions WHERE session_key=? AND session_last_access>=?"@@ -145,9 +139,6 @@ qryLookupSession'' :: Query qryLookupSession'' = "SELECT value FROM wai_pg_session_data WHERE wai_pg_session=? AND key=?" -qryLookupSession''' :: Query-qryLookupSession''' = "SELECT id FROM wai_pg_session_data WHERE wai_pg_session=? AND key=?"- qryPurgeOldSessions :: Query qryPurgeOldSessions = "DELETE FROM wai_pg_sessions WHERE session_last_access<?" @@ -167,12 +158,11 @@ dbStore :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> StoreSettings -> IO (SessionStore m k v) dbStore pool stos = do when (storeSettingsCreateTable stos) $- withPostgreSQLConn pool $ \ conn ->- unerror $ do- void $ execute_ conn qryCreateTable1- void $ execute_ conn qryCreateTable2- void $ execute_ conn qryCreateIndex1- storeSettingsLog stos "Created tables."+ withPostgreSQLConn pool $ \ conn -> do+ void $ execute_ conn qryCreateTable1+ void $ execute_ conn qryCreateTable2+ void $ execute_ conn qryCreateIndex1+ storeSettingsLog stos "Created tables." return $ dbStore' pool stos -- |Delete expired sessions from the database.@@ -279,11 +269,7 @@ let k' = Binary $ encode k v' = Binary $ encode v liftIO $ withPostgreSQLConn pool $ \conn ->- withTransaction conn $ do- res <- query conn qryLookupSession''' (sessionPgId, k') :: IO [Only Int64]- case res of- [Only id] -> void $ execute conn qryUpdateSessionEntry (v', sessionPgId, k')- _ -> void $ execute conn qryCreateSessionEntry (sessionPgId, k', v')+ void $ execute conn qryCreateOrUpdateSessionEntry (sessionPgId, k', v') ignoreSqlError :: SqlError -> IO () ignoreSqlError _ = return ()
test/Spec.hs view
@@ -2,66 +2,64 @@ module Main where import Control.Concurrent (threadDelay)-import Control.Exception.Base (assert)-import Control.Monad import Data.Default (def)-import Data.String (fromString) import Database.PostgreSQL.Simple-import Network.Wai.Session (withSession, Session) import Network.Wai.Session.PostgreSQL+import Test.Hspec import qualified Data.ByteString as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE main :: IO ()-main = do+main = hspec spec++spec :: Spec+spec = describe "Network.Wai.Session.PostgreSQL" $ it "handles sessions" $ do conn <- dbconnect conn' <- fromSimpleConnection conn store <- dbStore conn' testSettings purger conn' testSettings + -- new session ((lookupSess1, insertSess1), mknewsessid) <- store Nothing sessid <- mknewsessid - insertSess1 ("foo" :: B.ByteString) ("bar" :: B.ByteString)+ -- insert+ insertSess1 ("foo" :: B.ByteString) ("foo" :: B.ByteString)+ lookupSess1 "foo" `shouldReturn` Just "foo" - l1 <- lookupSess1 "foo"- assert (l1 == (Just "bar")) it+ -- update+ insertSess1 ("foo" :: B.ByteString) ("bar" :: B.ByteString)+ lookupSess1 "foo" `shouldReturn` Just "bar" - l2 <- lookupSess1 "bar"- assert (l2 == Nothing) it+ -- non-existing key+ lookupSess1 "bar" `shouldReturn` Nothing + -- existing session ((lookupSess2, insertSess2), mknewsessid) <- store $ Just sessid newsessid <- mknewsessid - l3 <- lookupSess2 "foo"- assert (l3 == (Just "bar")) it+ lookupSess2 "foo" `shouldReturn` Just "bar" - assert (newsessid == sessid) it+ newsessid `shouldBe` sessid + -- invalid session let invalidsessid = "foobar" ((lookupSess3, insertSess3), mknewsessid) <- store $ Just invalidsessid newsessid2 <- mknewsessid - assert (newsessid2 /= newsessid) it- assert (newsessid2 /= invalidsessid) it+ newsessid2 `shouldNotBe` newsessid+ newsessid2 `shouldNotBe` invalidsessid - l4 <- lookupSess3 "foo"- assert (l4 == Nothing) it+ lookupSess3 "foo" `shouldReturn` Nothing + -- re-accessing session ((lookupSess4, insertSess4), mknewsessid) <- store $ Just sessid- l5 <- lookupSess4 "foo"- assert (l5 == (Just "bar")) it-- threadDelay 6000000+ lookupSess4 "foo" `shouldReturn` Just "bar" + -- purged session+ threadDelay 2000000 ((lookupSess5, insertSess5), mknewsessid) <- store $ Just sessid- l6 <- lookupSess5 "foo"- assert (l6 == Nothing) it--it :: IO ()-it = return ()+ lookupSess5 "foo" `shouldReturn` Nothing dbconnect :: IO Connection dbconnect = do@@ -74,4 +72,4 @@ connectPostgreSQL $ postgreSQLConnectionString connectInfo testSettings :: StoreSettings-testSettings = def { storeSettingsSessionTimeout=5 }+testSettings = def { storeSettingsSessionTimeout=1 }
wai-session-postgresql.cabal view
@@ -1,5 +1,5 @@ name: wai-session-postgresql-version: 0.2.1.2+version: 0.2.1.3 synopsis: PostgreSQL backed Wai session store description: Provides a PostgreSQL backed session store for the Network.Wai.Session interface. homepage: https://github.com/hce/postgresql-session#readme@@ -46,6 +46,7 @@ , text , wai-session , wai-session-postgresql+ , hspec ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010