wai-session-postgresql 0.1.0.0 → 0.1.0.1
raw patch · 3 files changed
+161/−11 lines, 3 filesdep +data-defaultdep +entropydep +http-typesdep ~basedep ~bytestringdep ~cerealnew-component:exe:postgresql-session-exe
Dependencies added: data-default, entropy, http-types, text, vault, wai, wai-session-postgresql, warp
Dependency ranges changed: base, bytestring, cereal, postgresql-simple, time, transformers, wai-session
Files
- example/Main.hs +55/−0
- src/Network/Wai/Session/PostgreSQL.hs +78/−4
- wai-session-postgresql.cabal +28/−7
+ example/Main.hs view
@@ -0,0 +1,55 @@+-- 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,9 +1,14 @@ module Network.Wai.Session.PostgreSQL ( dbStore+ , defaultSettings+ , purgeOldSessions+ , purger+ , ratherSecureGen , WithPostgreSQLConn (..) , StoreSettings (..) ) where +import Control.Concurrent import Control.Exception.Base import Control.Exception import Control.Monad@@ -13,15 +18,45 @@ import Data.Time.Clock.POSIX (getPOSIXTime) import Database.PostgreSQL.Simple import Network.Wai.Session+import Numeric (showHex)+import System.Entropy (getEntropy) import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE -data StoreSettings = StoreSettings- { storeSettingsSessionTimeout :: Int64+-- |These settings control how the session store is behaving+data StoreSettings = StoreSettings {+ -- |The number of seconds a session is valid+ -- Seconds are counted since the session is last accessed (read or written),+ -- not since it was created.+ storeSettingsSessionTimeout :: Int64+ -- |A random session key generator. The session ID should provide+ -- sufficient entropy, and must not be predictable. It is recommended+ -- to use a cryptographically secure random number generator. , storeSettingsKeyGen :: IO B.ByteString+ -- |Whether to create the database table if it does not exist upon+ -- creating the session store. If set to false, the database table+ -- must exist or be created by some other means.+ , storeSettingsCreateTable :: Bool+ -- |A function that is called by to log events such as session+ -- purges or the table creation.+ , storeSettingsLog :: String -> IO ()+ -- |The number of microseconds to sleep between two runs of the+ -- old session purge worker.+ , storeSettingsPurgeInterval :: Int } +-- |By default, you pass a postgresql connection to the session store+-- when creating it. The passed connection will have to stay open+-- for the (possibly very long) existence of the session and it should+-- not be used for any other purpose during that time.+-- You can implement an instance of this class for a connection pool+-- instead, so that the session manager will not require a permanent+-- open PostgreSQL connection. class WithPostgreSQLConn a where+ -- |Call the function (Connection -> IO b) with a valid and open+ -- PostgreSQL connection. withPostgreSQLConn :: a -> (Connection -> IO b) -> IO b instance WithPostgreSQLConn Connection where@@ -33,12 +68,51 @@ 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<?" +-- |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) dbStore pool stos = do- withPostgreSQLConn pool $ \ conn ->- unerror $ execute_ conn qryCreateTable+ when (storeSettingsCreateTable stos) $+ withPostgreSQLConn pool $ \ conn ->+ unerror $ execute_ conn qryCreateTable return $ dbStore' pool stos++-- |Delete expired sessions from the database.+purgeOldSessions :: WithPostgreSQLConn a => a -> StoreSettings -> IO Int64+purgeOldSessions pool stos = do+ curtime <- round <$> liftIO getPOSIXTime+ count <- withPostgreSQLConn pool $ \ conn ->+ execute conn qryPurgeOldSessions (Only (curtime - storeSettingsSessionTimeout stos))+ storeSettingsLog stos $ "Purged " ++ show count ++ " session(s)."+ return count++-- |Run a thread using forkIO that runs periodically to+-- purge old sessions.+purger :: WithPostgreSQLConn a => a -> StoreSettings -> IO ThreadId+purger pool stos = forkIO . forever . unerror $ do+ purgeOldSessions pool stos+ threadDelay $ storeSettingsPurgeInterval stos++-- |Create default settings using a session timeout of+-- one hour, a cryptographically secure session id generator+-- using 24 bytes of entropy and putStrLn to log events+-- to stdout.+defaultSettings :: StoreSettings+defaultSettings = StoreSettings+ { storeSettingsSessionTimeout=3600+ , storeSettingsKeyGen=ratherSecureGen 24+ , storeSettingsCreateTable=True+ , storeSettingsLog=putStrLn+ , storeSettingsPurgeInterval=600000000+ }++-- |Generate a session ID with n bytes of entropy+ratherSecureGen :: Int -> IO B.ByteString+ratherSecureGen n = TE.encodeUtf8 . prettyPrint <$> getEntropy n++prettyPrint :: B.ByteString -> T.Text+prettyPrint = T.pack . concatMap (`showHex` "") . B.unpack dbStore' :: (WithPostgreSQLConn a, Serialize k, Eq k, Serialize v, MonadIO m) => a -> StoreSettings -> SessionStore m k v dbStore' pool stos Nothing = do
wai-session-postgresql.cabal view
@@ -1,8 +1,8 @@ name: wai-session-postgresql-version: 0.1.0.0+version: 0.1.0.1 synopsis: PostgreSQL backed Wai session store-description: Please see README.md-homepage: http://github.com/githubuser/postgresql-session#readme+description: Provides a PostgreSQL backed session store for the Network.Wai.Session interface.+homepage: http://github.com/hce/postgresql-session#readme license: BSD3 license-file: LICENSE author: Hans-Christian Esperer hc@hcesperer.org@@ -19,14 +19,35 @@ hs-source-dirs: src exposed-modules: Network.Wai.Session.PostgreSQL build-depends: base >= 4.7 && < 5+ , bytestring >= 0.10.6 && < 0.11+ , cereal >= 0.4.1 && < 0.5+ , entropy >= 0.3.7 && < 0.4+ , postgresql-simple >= 0.4.10 && < 0.5+ , text >= 1.2.1 && < 1.3+ , time >= 1.5.0 && < 1.6+ , transformers >= 0.4.2 && < 0.5+ , wai-session >= 0.3.2 && < 0.4+ 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- , cereal+ , data-default+ , entropy+ , http-types+ , wai-session-postgresql , postgresql-simple- , time- , transformers+ , text+ , vault+ , wai , wai-session+ , warp default-language: Haskell2010- default-extensions: OverloadedStrings+ test-suite postgresql-session-test type: exitcode-stdio-1.0