diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 -------------------- diff --git a/src/Network/Wai/Session/PostgreSQL.hs b/src/Network/Wai/Session/PostgreSQL.hs --- a/src/Network/Wai/Session/PostgreSQL.hs +++ b/src/Network/Wai/Session/PostgreSQL.hs @@ -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 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 () diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 } diff --git a/wai-session-postgresql.cabal b/wai-session-postgresql.cabal --- a/wai-session-postgresql.cabal +++ b/wai-session-postgresql.cabal @@ -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