packages feed

wai-session-postgresql 0.1.0.1 → 0.1.0.2

raw patch · 3 files changed

+44/−86 lines, 3 filesdep −data-defaultdep −http-typesdep −vaultdep ~basedep ~bytestringdep ~entropy

Dependencies removed: data-default, http-types, vault, wai, wai-session-postgresql, warp

Dependency ranges changed: base, bytestring, entropy, postgresql-simple, text, wai-session

Files

− example/Main.hs 
@@ -1,55 +0,0 @@--- copied from https://github.com/singpolyma/wai-session/blob/master/example/Main.hs and modified-module Main where--import Data.Default (def)-import Data.String (fromString)-import Database.PostgreSQL.Simple-import Numeric (showHex)-import Network.Wai-import Network.Wai.Session (withSession, Session)-import Network.Wai.Session.PostgreSQL-import Network.Wai.Handler.Warp (run)-import Network.HTTP.Types (ok200)-import System.Entropy (getEntropy)--import qualified Data.ByteString as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Vault.Lazy as Vault--app :: Vault.Key (Session IO String String) -> Application-app session env = (>>=) $ do-    u <- sessionLookup "u"-    sessionInsert "u" insertThis-    return $ responseLBS ok200 [] $ maybe (fromString "Nothing") fromString u-    where-        insertThis = show $ pathInfo env-        Just (sessionLookup, sessionInsert) = Vault.lookup session (vault env)--main :: IO ()-main = do-    conn <- dbconnect-    session <- Vault.newKey-    store <- dbStore conn settings-    purger conn settings-    run 3000 $ withSession store (fromString "SESSION") def session $ app session--settings :: StoreSettings-settings = defaultSettings--genSessionKey :: IO B.ByteString-genSessionKey =-    TE.encodeUtf8 . prettyPrint <$> getEntropy 24--dbconnect :: IO Connection-dbconnect = do-    let connectInfo = ConnectInfo {-          connectHost = "localhost"-        , connectPort = 5432-        , connectUser = "demo"-        , connectPassword = "omed"-        , connectDatabase = "demodb" }-    connectPostgreSQL $ postgreSQLConnectionString connectInfo--prettyPrint :: B.ByteString -> T.Text-prettyPrint = T.pack . concat . map (flip showHex "") . B.unpack
src/Network/Wai/Session/PostgreSQL.hs view
@@ -1,6 +1,7 @@ module Network.Wai.Session.PostgreSQL     ( dbStore     , defaultSettings+    , clearSession     , purgeOldSessions     , purger     , ratherSecureGen@@ -15,11 +16,14 @@ import Control.Monad.IO.Class import Data.Int (Int64) import Data.Serialize (encode, decode, Serialize)+import Data.String (fromString) import Data.Time.Clock.POSIX (getPOSIXTime) import Database.PostgreSQL.Simple+import Network.Wai (Request, requestHeaders) import Network.Wai.Session import Numeric (showHex) import System.Entropy (getEntropy)+import Web.Cookie (parseCookies)  import qualified Data.ByteString as B import qualified Data.Text as T@@ -62,13 +66,16 @@ instance WithPostgreSQLConn Connection where     withPostgreSQLConn conn = bracket (return conn) (\_ -> return ()) -qryCreateTable      = "CREATE TABLE session (id bigserial NOT NULL, session_key character varying NOT NULL, session_created_at bigint NOT NULL, session_last_access bigint NOT NULL, session_value bytea NOT NULL, CONSTRAINT session_pkey PRIMARY KEY (id), CONSTRAINT session_session_key_key UNIQUE (session_key)) WITH (OIDS=FALSE);"+qryCreateTable      = "CREATE TABLE session (id bigserial NOT NULL, session_key character varying NOT NULL, session_created_at bigint NOT NULL, session_last_access bigint NOT NULL, session_value bytea NOT NULL, session_invalidate_key bool NOT NULL DEFAULT FALSE, CONSTRAINT session_pkey PRIMARY KEY (id), CONSTRAINT session_session_key_key UNIQUE (session_key)) WITH (OIDS=FALSE);" qryCreateSession    = "INSERT INTO session (session_key, session_created_at, session_last_access, session_value) VALUES (?,?,?,?)" qryUpdateSession    = "UPDATE session SET session_value=?,session_last_access=? WHERE session_key=?" qryLookupSession    = "SELECT session_value FROM session WHERE session_key=? AND session_last_access>=?" qryLookupSession'   = "UPDATE session SET session_last_access=? WHERE session_key=?" qryLookupSession''  = "SELECT session_value FROM session WHERE session_key=?" qryPurgeOldSessions = "DELETE FROM session WHERE session_last_access<?"+qryCheckNewKey      = "SELECT session_invalidate_key FROM session WHERE session_key=?"+qryInvalidateSess   = "UPDATE session SET session_value=?,session_invalidate_key=TRUE WHERE session_key=?"+qryUpdateKey        = "UPDATE session SET session_key=?,session_invalidate_key=FALSE WHERE session_key=?"  -- |Create a new postgresql backed wai session store. dbStore :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> StoreSettings -> IO (SessionStore m k v)@@ -121,8 +128,8 @@         map'    = "" -- encode map     curtime <- round <$> liftIO getPOSIXTime     withPostgreSQLConn pool $ \ conn ->-        void $ execute conn qryCreateSession (newKey, curtime :: Int64, curtime, map' :: B.ByteString)-    backend pool newKey map+        void $ execute conn qryCreateSession (newKey, curtime :: Int64, curtime, Binary (map' :: B.ByteString))+    backend pool stos newKey map dbStore' pool stos (Just key) = do     let map     = [] :: [(k, v)]         map'    = "\"\"" -- encode map@@ -130,15 +137,40 @@     res <- withPostgreSQLConn pool $ \ conn ->         query conn qryLookupSession (key, curtime - storeSettingsSessionTimeout stos) :: IO [Only B.ByteString]     case res of-        [Only _]    -> backend pool key map+        [Only _]    -> backend pool stos key map         _           -> dbStore' pool stos Nothing -backend :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> B.ByteString -> [(k, v)] -> IO (Session m k v, IO B.ByteString)-backend pool key mappe =+-- |This function can be called to invalidate a session and enforce creating+-- a new one with a new session ID. It should be called *before* and calls+-- to sessionStore are made. It needs to be passed a request and the cookie+-- name explicitly due to the limited nature of the Network.Wai.Session+-- interface.+-- Sessions should be cleared when a login is performed, to prevent certain+-- kinds of session hijacking attacks.+clearSession :: (WithPostgreSQLConn a) => a -> B.ByteString -> Request -> IO ()+clearSession pool cookieName req = do+    let map         = [] :: [(k, v)]+        map'        = "" -- encode map+        cookies     = fmap parseCookies $ lookup (fromString "Cookie") (requestHeaders req)+        Just key    = lookup cookieName =<< cookies+    withPostgreSQLConn pool $ \ conn ->+        void $ execute conn qryInvalidateSess (Binary (map' :: B.ByteString), key)++backend :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> StoreSettings -> B.ByteString -> [(k, v)] -> IO (Session m k v, IO B.ByteString)+backend pool stos key mappe = do+     return ( (         (reader pool key mappe)-      , (writer pool key mappe) )-     , return key )+      , (writer pool key mappe) ), withPostgreSQLConn pool $ \conn -> do+        [Only shouldNewKey] <- query conn qryCheckNewKey (Only key)+        if shouldNewKey then do+            newKey' <- storeSettingsKeyGen stos+            execute conn qryUpdateKey (newKey', key)+            return newKey'+        else+            return key+      )+  reader :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> B.ByteString -> [(k, v)] -> k -> m (Maybe v) reader pool key mappe k = do
wai-session-postgresql.cabal view
@@ -1,13 +1,13 @@ name:                wai-session-postgresql-version:             0.1.0.1+version:             0.1.0.2 synopsis:            PostgreSQL backed Wai session store description:         Provides a PostgreSQL backed session store for the Network.Wai.Session interface.-homepage:            http://github.com/hce/postgresql-session#readme+homepage:            https://github.com/hce/postgresql-session#readme+bug-reports:         https://github.com/hce/postgresql-session/issues license:             BSD3 license-file:        LICENSE author:              Hans-Christian Esperer hc@hcesperer.org maintainer:          Hans-Christian Esperer hc@hcesperer.org-homepage:            https://github.com/hce/postgresql-session copyright:           2015 Hans-Christian Esperer stability:           experimental tested-with:         GHC == 7.10.2@@ -30,25 +30,6 @@   default-language:    Haskell2010   default-extensions:  OverloadedStrings -executable postgresql-session-exe-  hs-source-dirs:      example-  main-is:             Main.hs-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  build-depends:       base-                     , bytestring-                     , data-default-                     , entropy-                     , http-types-                     , wai-session-postgresql-                     , postgresql-simple-                     , text-                     , vault-                     , wai-                     , wai-session-                     , warp-  default-language:    Haskell2010-- test-suite postgresql-session-test   type:                exitcode-stdio-1.0   hs-source-dirs:      test@@ -60,4 +41,4 @@  source-repository head   type:     git-  location: https://github.com/githubuser/postgresql-session+  location: https://github.com/hce/postgresql-session