wai-session (empty) → 0.1

raw patch · 6 files changed

+193/−0 lines, 6 filesdep +StateVardep +basedep +blaze-buildersetup-changed

Dependencies added: StateVar, base, blaze-builder, bytestring, containers, cookie, http-types, time, transformers, vault, wai

Files

COPYING +13/−0
Network/Wai/Session.hs +60/−0
Network/Wai/Session/Map.hs +56/−0
README +10/−0
Setup.hs +3/−0
wai-session.cabal +51/−0

+ COPYING view

@@ -0,0 +1,13 @@+Copyright © 2012, Stephen Paul Weber <singpolyma.net>++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

+ Network/Wai/Session.hs view

@@ -0,0 +1,60 @@+module Network.Wai.Session (Session, SessionStore, withSession, genSessionId) where++import Data.Unique (newUnique, hashUnique)+import Data.Ratio (numerator, denominator)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Data.String (fromString)+import Control.Monad.Trans.Class (lift)+import Network.HTTP.Types (ResponseHeaders)+import Network.Wai (Middleware, Request(..), Response(..))+import Web.Cookie (parseCookies, renderSetCookie, SetCookie(..))++import Data.Vault (Key)+import qualified Data.Vault as Vault+import Data.ByteString (ByteString)+import qualified Blaze.ByteString.Builder as Builder++-- | Type representing a single session (a lookup, insert pair)+type Session m k v = ((k -> m (Maybe v)), (k -> v -> m ()))++-- | A 'SessionStore' takes in the contents of the cookie (if there was one)+-- and returns a ('Session', 'IO' action to get new contents for cookie) pair+type SessionStore m k v = (Maybe ByteString -> IO (Session m k v, IO ByteString))++-- | Fully parameterised middleware for cookie-based sessions+withSession ::+	SessionStore m k v+	-- ^ The 'SessionStore' to use for sessions+	-> ByteString+	-- ^ Name to use for the session cookie (MUST BE ASCII)+	-> SetCookie+	-- ^ Settings for the cookie (path, expiry, etc)+	-> Key (Session m k v)+	-- ^ 'Data.Vault.Vault' key to use when passing the session through+	-> Middleware+withSession sessions cookieName cookieDefaults vkey app req = do+	(session, getNewCookie) <- lift $ sessions $ lookup cookieName =<< cookies+	resp <- app (req {vault = Vault.insert vkey session (vault req)})+	newCookieVal <- lift getNewCookie+	return $ mapHeader (\hs -> (setCookie, newCookie newCookieVal):hs) resp+	where+	newCookie v = Builder.toByteString $ renderSetCookie $ cookieDefaults {+			setCookieName = cookieName, setCookieValue = v+		}+	cookies = fmap parseCookies $ lookup ciCookie (requestHeaders req)+	setCookie = fromString "Set-Cookie"+	ciCookie = fromString "Cookie"++-- | Simple session ID generator based on time and 'Data.Unique'+--+-- Useful for session stores that use session IDs.+genSessionId :: IO ByteString+genSessionId = do+	u <- fmap (toInteger . hashUnique) newUnique+	time <- fmap toRational getPOSIXTime+	return $ fromString $ show (numerator time * denominator time * u)++mapHeader :: (ResponseHeaders -> ResponseHeaders) -> Response -> Response+mapHeader f (ResponseFile s h b1 b2) = ResponseFile s (f h) b1 b2+mapHeader f (ResponseBuilder s h b) = ResponseBuilder s (f h) b+mapHeader f (ResponseSource s h b) = ResponseSource s (f h) b

+ Network/Wai/Session/Map.hs view

@@ -0,0 +1,56 @@+module Network.Wai.Session.Map (mapStore, mapStore_) where++import Control.Monad+import Data.StateVar+import Data.ByteString (ByteString)+import Control.Monad.IO.Class (liftIO, MonadIO)+import Data.IORef+import Network.Wai.Session (Session, SessionStore, genSessionId)++import Data.Map (Map)+import qualified Data.Map as Map++-- | Simple session store based on threadsafe 'Data.IORef.IORef's and+-- 'Data.Map.Map'.  This only works if your application server remains+-- running (such as with warp).  All data is lost when the server+-- terminates (bad for CGI).+--+-- WARNING: This session is vulnerable to sidejacking,+-- use with TLS for security.+mapStore :: (Ord k, MonadIO m) =>+	IO ByteString+	-- ^ 'IO' action to generate unique session IDs+	-> IO (SessionStore m k v)+mapStore gen =+	liftM (mapStore' gen) (newThreadSafeStateVar Map.empty)+	where+	mapStore' _ ssv (Just k) = do+		m <- get ssv+		case Map.lookup k m of+			Just sv -> return (sessionFromMapStateVar sv, return k)+			-- Could not find key, so it's as if we were not sent one+			Nothing -> mapStore' (return k) ssv Nothing+	mapStore' genNewKey ssv Nothing = do+		newKey <- genNewKey+		sv <- newThreadSafeStateVar Map.empty+		ssv $~ Map.insert newKey sv+		return (sessionFromMapStateVar sv, return newKey)++-- | Store using simple session ID generator based on time and 'Data.Unique'+mapStore_ :: (Ord k, MonadIO m) => IO (SessionStore m k v)+mapStore_ = mapStore genSessionId++newThreadSafeStateVar :: a -> IO (StateVar a)+newThreadSafeStateVar a = do+	ref <- newIORef a+	return $ makeStateVar+		(atomicModifyIORef ref (\x -> (x,x)))+		(\x -> atomicModifyIORef ref (const (x,())))++sessionFromMapStateVar :: (HasGetter sv, HasSetter sv, Ord k, MonadIO m) =>+	sv (Map k v) ->+	Session m k v+sessionFromMapStateVar sv = (+		(\k -> liftIO (Map.lookup k `liftM` get sv)),+		(\k v -> liftIO (sv $~ Map.insert k v))+	)

+ README view

@@ -0,0 +1,10 @@+Provides a generic, cookie-based middleware for sessions that is+parameterised over the session store, the cookie name, and the+cookie parameters (such as path, expiry, etc).  Passes a pair of+functions (lookup key, set key) for the current session through the+'Vault' in the 'Request'.++Also provides a simple example session store based on threadsafe+'IORef's and 'Data.Map'.++See example/Main.hs in git for example usage.

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

+ wai-session.cabal view

@@ -0,0 +1,51 @@+name:            wai-session+version:         0.1+cabal-version:   >= 1.8+license:         OtherLicense+license-file:    COPYING+category:        Web+copyright:       © 2012 Stephen Paul Weber+author:          Stephen Paul Weber <singpolyma@singpolyma.net>+maintainer:      Stephen Paul Weber <singpolyma@singpolyma.net>+stability:       experimental+tested-with:     GHC == 7.0.3+synopsis:        Flexible session middleware for WAI+homepage:        https://github.com/singpolyma/wai-session+bug-reports:     https://github.com/singpolyma/wai-session/issues+build-type:      Simple+description:+        Provides a generic, cookie-based middleware for sessions that is+        parameterised over the session store, the cookie name, and the+        cookie parameters (such as path, expiry, etc).  Passes a pair of+        functions (lookup key, set key) for the current session through the+        'Vault' in the 'Request'.+        .+        Also provides a simple example session store based on threadsafe+        'IORef's and 'Data.Map'.+        .+        See example/Main.hs in git for example usage.++extra-source-files:+        README++library+        exposed-modules:+                Network.Wai.Session,+                Network.Wai.Session.Map++        build-depends:+                base == 4.*,+                containers,+                bytestring,+                transformers,+                time,+                StateVar,+                vault,+                cookie,+                wai >= 1.1.0,+                http-types,+                blaze-builder++source-repository head+        type:     git+        location: git://github.com/singpolyma/wai-session.git