wai-session-postgresql 0.2.0.2 → 0.2.0.3
raw patch · 3 files changed
+98/−30 lines, 3 filesdep ~basedep ~bytestringdep ~data-defaultPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, bytestring, data-default, entropy, postgresql-simple, text, time, transformers, wai
API changes (from Hackage documentation)
Files
- src/Network/Wai/Session/PostgreSQL.hs +19/−18
- test/Spec.hs +63/−1
- wai-session-postgresql.cabal +16/−11
src/Network/Wai/Session/PostgreSQL.hs view
@@ -29,6 +29,7 @@ , WithPostgreSQLConn (..) ) where +import Control.Applicative ((<$>)) import Control.Concurrent import Control.Concurrent.MVar import Control.Exception.Base@@ -126,37 +127,37 @@ qryCreateSessionEntry :: Query qryCreateSessionEntry = "INSERT INTO wai_pg_session_data (wai_pg_session,key,value) VALUES (?,?,?)" -qryUpdateSession :: Query+qryUpdateSession :: Query qryUpdateSession = "UPDATE wai_pg_sessions SET session_last_access=? WHERE id=?" -qryUpdateSessionEntry :: Query+qryUpdateSessionEntry :: Query qryUpdateSessionEntry = "UPDATE wai_pg_session_data SET value=? WHERE wai_pg_session=? AND key=?" -qryLookupSession :: Query+qryLookupSession :: Query qryLookupSession = "SELECT id FROM wai_pg_sessions WHERE session_key=? AND session_last_access>=?" -qryLookupSession' :: Query+qryLookupSession' :: Query qryLookupSession' = "UPDATE wai_pg_sessions SET session_last_access=? WHERE id=?" -qryLookupSession'' :: Query+qryLookupSession'' :: Query qryLookupSession'' = "SELECT value FROM wai_pg_session_data WHERE wai_pg_session=? AND key=?" -qryLookupSession''' :: Query+qryLookupSession''' :: Query qryLookupSession''' = "SELECT id FROM wai_pg_session_data WHERE wai_pg_session=? AND key=?" -qryPurgeOldSessions :: Query+qryPurgeOldSessions :: Query qryPurgeOldSessions = "DELETE FROM wai_pg_sessions WHERE session_last_access<?" -qryCheckNewKey :: Query+qryCheckNewKey :: Query qryCheckNewKey = "SELECT session_invalidate_key FROM wai_pg_sessions WHERE session_key=?" -qryInvalidateSess1 :: Query+qryInvalidateSess1 :: Query qryInvalidateSess1 = "UPDATE wai_pg_sessions SET session_invalidate_key=TRUE WHERE session_key=?" -qryInvalidateSess2 :: Query+qryInvalidateSess2 :: Query qryInvalidateSess2 = "DELETE FROM wai_pg_session_data WHERE wai_pg_session=(SELECT id FROM wai_pg_sessions WHERE session_key=?)" -qryUpdateKey :: Query+qryUpdateKey :: Query qryUpdateKey = "UPDATE wai_pg_sessions SET session_key=?,session_invalidate_key=FALSE WHERE session_key=?" -- |Create a new postgresql backed wai session store.@@ -209,9 +210,9 @@ dbStore' :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> StoreSettings -> SessionStore m k v dbStore' pool stos Nothing = do newKey <- storeSettingsKeyGen stos- curtime <- round <$> liftIO getPOSIXTime+ curtime <- liftIO getPOSIXTime sessionPgId <- withPostgreSQLConn pool $ \ conn -> do- [Only res] <- query conn qryCreateSession (newKey, curtime :: Int64, curtime) :: IO [Only Int64]+ [Only res] <- query conn qryCreateSession (newKey, round curtime :: Int64, round curtime :: Int64) :: IO [Only Int64] return (res :: Int64) backend pool stos newKey sessionPgId dbStore' pool stos (Just key) = do@@ -245,6 +246,10 @@ return ( ( reader pool key sessionPgId , writer pool key sessionPgId ), withPostgreSQLConn pool $ \conn -> do+ -- Update session access time+ curtime <- liftIO getPOSIXTime+ void $ execute conn qryLookupSession' (round curtime :: Int64, sessionPgId)+ [Only shouldNewKey] <- query conn qryCheckNewKey (Only key) if shouldNewKey then do newKey' <- storeSettingsKeyGen stos@@ -257,9 +262,7 @@ reader :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> B.ByteString -> Int64 -> k -> m (Maybe v) reader pool key sessionPgId k = do- curtime <- round <$> liftIO getPOSIXTime res <- liftIO $ withPostgreSQLConn pool $ \conn -> do- void $ execute conn qryLookupSession' (curtime :: Int64, sessionPgId) query conn qryLookupSession'' (sessionPgId, Binary $ encode k) case res of [Only value] -> case decode (fromBinary value) of@@ -269,7 +272,6 @@ writer :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> B.ByteString -> Int64 -> k -> v -> m () writer pool key sessionPgId k v = do- curtime <- round <$> liftIO getPOSIXTime let k' = Binary $ encode k v' = Binary $ encode v liftIO $ withPostgreSQLConn pool $ \conn ->@@ -278,10 +280,9 @@ case res of [Only id] -> void $ execute conn qryUpdateSessionEntry (v', sessionPgId, k') _ -> void $ execute conn qryCreateSessionEntry (sessionPgId, k', v')- void $ execute conn qryUpdateSession (curtime :: Int64, sessionPgId) ignoreSqlError :: SqlError -> IO ()-ignoreSqlError _ = pure ()+ignoreSqlError _ = return () unerror :: IO a -> IO () unerror action = void action `catch` ignoreSqlError
test/Spec.hs view
@@ -1,2 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++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 qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+ main :: IO ()-main = putStrLn "Test suite not yet implemented"+main = do+ conn <- dbconnect+ conn' <- fromSimpleConnection conn+ store <- dbStore conn' def+ purger conn' def++ ((lookupSess1, insertSess1), mknewsessid) <- store Nothing+ sessid <- mknewsessid++ insertSess1 ("foo" :: B.ByteString) ("bar" :: B.ByteString)++ l1 <- lookupSess1 "foo"+ assert (l1 == (Just "bar")) it++ l2 <- lookupSess1 "bar"+ assert (l2 == Nothing) it++ ((lookupSess2, insertSess2), mknewsessid) <- store $ Just sessid+ newsessid <- mknewsessid++ l3 <- lookupSess2 "foo"+ assert (l3 == (Just "bar")) it++ assert (newsessid == sessid) it++ let invalidsessid = "foobar"+ ((lookupSess3, insertSess3), mknewsessid) <- store $ Just invalidsessid+ newsessid2 <- mknewsessid++ assert (newsessid2 /= newsessid) it+ assert (newsessid2 /= invalidsessid) it++ l3 <- lookupSess3 "foo"+ assert (l3 == Nothing) it+++it :: IO ()+it = return ()++dbconnect :: IO Connection+dbconnect = do+ let connectInfo = ConnectInfo {+ connectHost = "localhost"+ , connectPort = 5432+ , connectUser = "demo"+ , connectPassword = "omed"+ , connectDatabase = "demodb" }+ connectPostgreSQL $ postgreSQLConnectionString connectInfo
wai-session-postgresql.cabal view
@@ -1,5 +1,5 @@ name: wai-session-postgresql-version: 0.2.0.2+version: 0.2.0.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@@ -19,18 +19,18 @@ library hs-source-dirs: src exposed-modules: Network.Wai.Session.PostgreSQL- build-depends: base >= 4.7 && < 5- , bytestring >= 0.10.6 && < 0.11+ build-depends: base >= 4.5 && < 5+ , bytestring >= 0.10.0.2 && < 0.11 , cereal >= 0.4.1 && < 0.6 , cookie >= 0.4.1 && < 0.5- , data-default >= 0.5.3 && < 0.6- , entropy >= 0.3.7 && < 0.4- , postgresql-simple >= 0.4.10 && < 0.6+ , data-default >= 0.5.1 && < 0.6+ , entropy >= 0.3 && < 0.4+ , postgresql-simple >= 0.4.0 && < 0.6 , resource-pool >= 0.2.3 && < 0.3- , text >= 1.2.1 && < 1.3- , time >= 1.5.0 && < 1.6- , transformers >= 0.4.2 && < 0.5- , wai >= 3.0.3 && < 3.1+ , text >= 0.11.3.1 && < 1.3+ , time >= 1.4.0.1 && < 1.6+ , transformers >= 0.3.0 && < 0.5+ , wai >= 3.0.2.3 && < 3.1 , wai-session >= 0.3.2 && < 0.4 default-language: Haskell2010 default-extensions: OverloadedStrings@@ -40,8 +40,13 @@ hs-source-dirs: test main-is: Spec.hs build-depends: base+ , bytestring >= 0.10.0.2 && < 0.11+ , data-default >= 0.5.1 && < 0.6+ , postgresql-simple >= 0.4.0 && < 0.6+ , text >= 0.11.3.1 && < 1.3+ , wai-session >= 0.3.2 && < 0.4 , wai-session-postgresql- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -O0 default-language: Haskell2010 source-repository head