diff --git a/mysnapsession.cabal b/mysnapsession.cabal
--- a/mysnapsession.cabal
+++ b/mysnapsession.cabal
@@ -1,5 +1,5 @@
 Name:                mysnapsession
-Version:             0.1.2
+Version:             0.2
 Synopsis:            Memory-backed sessions and continuations for Snap web apps
 Description:         This package provides two Snap extensions.  The first is
                      an in-memory session manager, which stores sessions for
@@ -31,10 +31,13 @@
     time >= 1.1 && < 1.3,
     random == 1.0.*,
     containers >= 0.3 && < 0.5,
-    regex-posix == 0.94.*
+    regex-posix == 0.94.*,
+    clientsession == 0.4.*,
+    cereal == 0.3.*
   Exposed-modules: Snap.Extension.Session,
                    Snap.Extension.Session.Memory,
-                   Snap.Extension.SessionUtil,
-                   Snap.Extension.Dialogues
+                   Snap.Extension.Session.Client,
+                   Snap.SessionUtil,
+                   Snap.Dialogues
 
   Ghc-options: -Wall -fwarn-tabs -funbox-strict-fields
diff --git a/src/Snap/Dialogues.hs b/src/Snap/Dialogues.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Dialogues.hs
@@ -0,0 +1,135 @@
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE FunctionalDependencies     #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+module Snap.Dialogues (
+    DlgManager,
+    makeDlgManager,
+    HasDlgManager(..),
+    Dlg,
+    Page,
+    showPage,
+    dialogue
+    )
+    where
+
+import Control.Applicative
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.Trans
+import Snap.Extension.Session
+import Snap.SessionUtil
+import Snap.Types
+import Text.Regex.Posix
+
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+
+import Data.Map (Map)
+import qualified Data.Map as M
+
+newtype DlgManager m = DlgManager {
+    unDlgManager :: MVar (Map SessionKey (Dlg m ()))
+    }
+
+makeDlgManager :: IO (DlgManager m)
+makeDlgManager = fmap DlgManager (newMVar M.empty)
+
+class HasDlgManager m a | a -> m where
+    getDlgManager :: a -> DlgManager m
+
+{-|
+    A value of a 'Dlg' type represents a dialogue between the user and the
+    application, after which the application builds a value of type 'a'.  The
+    trivial case is that the value is already known.  Alternatively, it may be
+    that there is some action to be performed, or else that the user needs to
+    be asked or told something.
+-}
+data Dlg m a = Done a
+             | Action (m (Dlg m a))
+             | Step (Page m) (Dlg m a)
+
+{-|
+    A value of 'Page' type represents a way of rendering a page, given a request URI
+    that should be used for subsequent requests in order to reassociate them with the
+    current dialogue.
+-}
+type Page m = ByteString -> m ()
+
+{-
+    Dlg is a monad in the obvious way: return represents a dialogue that has no
+    steps; and (>>=) combines dialogues by doing the first part of the first
+    dialogue, and then continuing with the rest.
+-}
+instance Monad m => Monad (Dlg m) where
+    return         = Done
+    Done x   >>= y = y x
+    Action x >>= y = Action (x >>= return . (>>= y))
+    Step p f >>= y = Step p (f >>= y)
+
+{-
+    Converts an action in the underlying Monad into a Dlg.  This is essentially
+    a mechanism for escaping the confines of the dialogue mechanism and
+    performing your own processing with the request.
+-}
+instance MonadTrans Dlg where
+    lift x = Action (x >>= return . Done)
+
+{-
+    Dlg is an instance of MonadIO by passing it through to the underlying monad. 
+-}
+instance MonadIO m => MonadIO (Dlg m) where
+    liftIO = lift . liftIO
+
+{-|
+    Converts methods for rendering and parsing the result of a page into a
+    'Dlg' step.
+-}
+showPage :: Monad m => Page m -> m a -> Dlg m a
+showPage p r = Step p (Action (r >>= return . Done))
+
+dlgToken :: MonadSnap m => ByteString -> (SessionKey -> m a) -> m a 
+dlgToken tname action = popPathTo $ \token ->
+    case token =~ ("^([^\\-]*)-([0-9]+)$" :: ByteString) of
+        [[_, name, tok]] | name == tname -> action $ read $ B.unpack tok
+        _                                -> pass
+
+findDlg :: (MonadSession m, HasDlgManager m t, t ~ SessionValue m)
+        => SessionKey
+        -> m (Dlg m ())
+findDlg tok = do
+    dref <- fmap (unDlgManager . getDlgManager) getSession
+    dlgs <- liftIO $ readMVar dref
+    maybe mzero return $ M.lookup tok dlgs
+
+handle :: (MonadSession m, HasDlgManager m t, t ~ SessionValue m)
+       => ByteString -> Dlg m () -> m ()
+handle _    (Done _)   = pass
+handle name (Action a) = a >>= handle name
+handle name (Step p f) = do
+    dref <- fmap (unDlgManager . getDlgManager) getSession
+    dlgs <- liftIO $ takeMVar dref
+    k    <- liftIO $ uniqueKey dlgs
+    liftIO $ putMVar dref (M.insert k f dlgs)
+    p (name `B.append` "-" `B.append` B.pack (show k))
+
+{-|
+    The 'dialogue' function builds a 'Snap ()' that handles a given dialogue.
+    The URLs of the dialog are of the form "/.../dlg-55555", where "dlg" is
+    the prefix (passed as a parameter) and 55555 is the (numeric) dialogue ID.
+    Requests to "/.../dlg" create a new dialogue.
+
+    In general, this can be combined in normal ways with other routing constructs,
+    so long as request URIs of the above forms reach this handler.  When pages are
+    served as part of a dialog, their relative paths are passed on to later handlers,
+-}
+dialogue :: (MonadSession m, HasDlgManager m t, t ~ SessionValue m)
+         => ByteString
+         -> Dlg m ()
+         -> m ()
+dialogue name dlg = new <|> continue
+  where
+    new      = dir name $ ifTop $ handle name dlg
+    continue = dlgToken name $ \key -> ifTop $ findDlg key >>= handle name
+
diff --git a/src/Snap/Extension/Dialogues.hs b/src/Snap/Extension/Dialogues.hs
deleted file mode 100644
--- a/src/Snap/Extension/Dialogues.hs
+++ /dev/null
@@ -1,135 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE FunctionalDependencies     #-}
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE OverloadedStrings          #-}
-
-module Snap.Extension.Dialogues (
-    DlgManager,
-    makeDlgManager,
-    HasDlgManager(..),
-    Dlg,
-    Page,
-    showPage,
-    dialogue
-    )
-    where
-
-import Control.Applicative
-import Control.Concurrent
-import Control.Monad
-import Control.Monad.Trans
-import Snap.Extension.Session
-import Snap.Extension.SessionUtil
-import Snap.Types
-import Text.Regex.Posix
-
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-
-import Data.Map (Map)
-import qualified Data.Map as M
-
-newtype DlgManager m = DlgManager {
-    unDlgManager :: MVar (Map SessionKey (Dlg m ()))
-    }
-
-makeDlgManager :: IO (DlgManager m)
-makeDlgManager = fmap DlgManager (newMVar M.empty)
-
-class HasDlgManager m a | a -> m where
-    getDlgManager :: a -> DlgManager m
-
-{-|
-    A value of a 'Dlg' type represents a dialogue between the user and the
-    application, after which the application builds a value of type 'a'.  The
-    trivial case is that the value is already known.  Alternatively, it may be
-    that there is some action to be performed, or else that the user needs to
-    be asked or told something.
--}
-data Dlg m a = Done a
-             | Action (m (Dlg m a))
-             | Step (Page m) (Dlg m a)
-
-{-|
-    A value of 'Page' type represents a way of rendering a page, given a request URI
-    that should be used for subsequent requests in order to reassociate them with the
-    current dialogue.
--}
-type Page m = ByteString -> m ()
-
-{-
-    Dlg is a monad in the obvious way: return represents a dialogue that has no
-    steps; and (>>=) combines dialogues by doing the first part of the first
-    dialogue, and then continuing with the rest.
--}
-instance Monad m => Monad (Dlg m) where
-    return         = Done
-    Done x   >>= y = y x
-    Action x >>= y = Action (x >>= return . (>>= y))
-    Step p f >>= y = Step p (f >>= y)
-
-{-
-    Converts an action in the underlying Monad into a Dlg.  This is essentially
-    a mechanism for escaping the confines of the dialogue mechanism and
-    performing your own processing with the request.
--}
-instance MonadTrans Dlg where
-    lift x = Action (x >>= return . Done)
-
-{-
-    Dlg is an instance of MonadIO by passing it through to the underlying monad. 
--}
-instance MonadIO m => MonadIO (Dlg m) where
-    liftIO = lift . liftIO
-
-{-|
-    Converts methods for rendering and parsing the result of a page into a
-    'Dlg' step.
--}
-showPage :: Monad m => Page m -> m a -> Dlg m a
-showPage p r = Step p (Action (r >>= return . Done))
-
-dlgToken :: MonadSnap m => ByteString -> (SessionKey -> m a) -> m a 
-dlgToken tname action = popPathTo $ \token ->
-    case token =~ ("^([^\\-]*)-([0-9]+)$" :: ByteString) of
-        [[_, name, tok]] | name == tname -> action $ read $ B.unpack tok
-        _                                -> pass
-
-findDlg :: (MonadSession m, HasDlgManager m t, t ~ SessionValue m)
-        => SessionKey
-        -> m (Dlg m ())
-findDlg tok = do
-    dref <- fmap (unDlgManager . getDlgManager) getSessionObject
-    dlgs <- liftIO $ readMVar dref
-    maybe mzero return $ M.lookup tok dlgs
-
-handle :: (MonadSession m, HasDlgManager m t, t ~ SessionValue m)
-       => ByteString -> Dlg m () -> m ()
-handle _    (Done _)   = pass
-handle name (Action a) = a >>= handle name
-handle name (Step p f) = do
-    dref <- fmap (unDlgManager . getDlgManager) getSessionObject
-    dlgs <- liftIO $ takeMVar dref
-    k    <- liftIO $ uniqueKey dlgs
-    liftIO $ putMVar dref (M.insert k f dlgs)
-    p (name `B.append` "-" `B.append` B.pack (show k))
-
-{-|
-    The 'dialogue' function builds a 'Snap ()' that handles a given dialogue.
-    The URLs of the dialog are of the form "/.../dlg-55555", where "dlg" is
-    the prefix (passed as a parameter) and 55555 is the (numeric) dialogue ID.
-    Requests to "/.../dlg" create a new dialogue.
-
-    In general, this can be combined in normal ways with other routing constructs,
-    so long as request URIs of the above forms reach this handler.  When pages are
-    served as part of a dialog, their relative paths are passed on to later handlers,
--}
-dialogue :: (MonadSession m, HasDlgManager m t, t ~ SessionValue m)
-         => ByteString
-         -> Dlg m ()
-         -> m ()
-dialogue name dlg = new <|> continue
-  where
-    new      = dir name $ ifTop $ handle name dlg
-    continue = dlgToken name $ \key -> ifTop $ findDlg key >>= handle name
-
diff --git a/src/Snap/Extension/Session.hs b/src/Snap/Extension/Session.hs
--- a/src/Snap/Extension/Session.hs
+++ b/src/Snap/Extension/Session.hs
@@ -12,6 +12,7 @@
 
 class MonadSnap m => MonadSession m where
     type SessionValue m
-    getSessionObject :: m (SessionValue m)
-    putSessionObject :: SessionValue m -> m ()
+    getSession   :: m (SessionValue m)
+    putSession   :: SessionValue m -> m ()
+    touchSession :: m ()
 
diff --git a/src/Snap/Extension/Session/Client.hs b/src/Snap/Extension/Session/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/Extension/Session/Client.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TypeFamilies               #-}
+
+module Snap.Extension.Session.Client (
+    HasClientSessionManager(..),
+    ClientSessionManager,
+    clientSessionInitializer
+    ) where
+
+import Control.Applicative
+import Control.Monad.Reader
+import Data.ByteString.Char8 (ByteString)
+import Data.Maybe
+import Data.Serialize
+import Data.Time.Clock
+import Data.Time.Clock.POSIX
+import Snap.Extension
+import Snap.Extension.Session
+import Snap.SessionUtil
+import Snap.Types
+import Web.ClientSession
+
+class HasClientSessionManager a where
+    type ClientSessionValue a
+    clientSessionMgr :: a -> ClientSessionManager (ClientSessionValue a)
+
+data ClientSessionManager t = ClientSessionManager {
+    clientSessionKey     :: Key,
+    clientSessionDefault :: t,
+    clientSessionTimeout :: Maybe NominalDiffTime
+    }
+
+clientSessionInitializer :: Key
+                         -> t
+                         -> Maybe NominalDiffTime
+                         -> Initializer (ClientSessionManager t)
+clientSessionInitializer key defaultVal timeout =
+    mkInitializer (ClientSessionManager key defaultVal timeout)
+
+instance InitializerState (ClientSessionManager t) where
+    extensionId = const "Session/Client"
+    mkCleanup   = const $ return ()
+    mkReload    = const $ return ()
+
+{-
+    The actual value encrypted and stored in the session contains not only the
+    desired value, but also the client and the current time.  This protects the
+    session from cross-site session stealing attacks, and prevents stale session
+    attacks.
+-}
+type SessionRecord t = (ByteString, UTCTime, t)
+
+instance Serialize UTCTime where
+    put t = put (round (utcTimeToPOSIXSeconds t) :: Integer)
+    get   = posixSecondsToUTCTime . fromInteger <$> get
+
+valToRecord :: (MonadSnap m, Serialize t) => t -> m (SessionRecord t)
+valToRecord val = do
+     rq  <- getRequest
+     t   <- liftIO getCurrentTime
+     return (rqRemoteAddr rq, t, val)
+
+recordToVal :: (MonadSnap m, Serialize t)
+            => ClientSessionManager t -> SessionRecord t -> m t
+recordToVal mgr (client, time, val) = do
+    addr <- fmap rqRemoteAddr getRequest
+    if addr /= client
+        then return (clientSessionDefault mgr)
+        else do
+            t    <- liftIO getCurrentTime
+            case clientSessionTimeout mgr of
+                Nothing -> return val
+                Just lim-> if t `diffUTCTime` time > lim
+                                then return (clientSessionDefault mgr)
+                                else return val
+
+getSessionRecord :: (MonadSnap m, Serialize t)
+                 => ClientSessionManager t -> m (SessionRecord t)
+getSessionRecord mgr = do
+     cookie <- getCookie "sessionval"
+     case cookie of
+         Nothing -> valToRecord (clientSessionDefault mgr)
+         Just c  -> case decrypt (clientSessionKey mgr) (cookieValue c) of
+             Nothing    -> valToRecord (clientSessionDefault mgr)
+             Just unenc -> case decode unenc of
+                 Left _    -> valToRecord (clientSessionDefault mgr)
+                 Right rec -> return rec
+
+putSessionRecord :: (MonadSnap m, Serialize t)
+                 => ClientSessionManager t -> SessionRecord t -> m ()
+putSessionRecord mgr record = do
+    let str = encrypt (clientSessionKey mgr) (encode record)
+    setCookie $ Cookie "sessionval" str Nothing Nothing Nothing
+
+instance (HasClientSessionManager s, Serialize (ClientSessionValue s))
+        => MonadSession (SnapExtend s) where
+    type SessionValue (SnapExtend s) = ClientSessionValue s
+
+    getSession = do
+        mgr <- asks clientSessionMgr
+        v <- recordToVal mgr =<< getSessionRecord mgr
+        return v
+
+    putSession v = do
+        mgr <- asks clientSessionMgr
+        putSessionRecord mgr =<< valToRecord v
+
+    touchSession = do
+        mgr <- asks clientSessionMgr
+        v <- recordToVal mgr =<< getSessionRecord mgr
+        when (isJust (clientSessionTimeout mgr)) $ do
+            putSessionRecord mgr =<< valToRecord v
+
diff --git a/src/Snap/Extension/Session/Memory.hs b/src/Snap/Extension/Session/Memory.hs
--- a/src/Snap/Extension/Session/Memory.hs
+++ b/src/Snap/Extension/Session/Memory.hs
@@ -20,7 +20,7 @@
 import Data.Time.Clock
 import Snap.Extension
 import Snap.Extension.Session
-import Snap.Extension.SessionUtil
+import Snap.SessionUtil
 import Snap.Types
 
 import Data.Map (Map)
@@ -53,14 +53,14 @@
 -}
 data MemorySessionManager obj = MemorySessionManager {
     sessionMgrClosed  :: MVar Bool,
-    sessionMgrMap     :: MVar (Map SessionKey (Session obj)),
+    sessionMgrMap     :: MVar (Map SessionKey (SessionWrapper obj)),
     sessionMgrDefault :: IO obj
     }
 
 {-
     A session contains the user session object and the dialogue map.
 -}
-data Session obj = Session {
+data SessionWrapper obj = SessionWrapper {
     sessionClient      :: ByteString,
     sessionLastTouched :: MVar UTCTime,
     sessionObject      :: MVar obj
@@ -69,7 +69,7 @@
 {-|
     Determines whether a session is still valid or not.
 -}
-goodSession :: NominalDiffTime -> (SessionKey, Session obj) -> IO Bool
+goodSession :: NominalDiffTime -> (SessionKey, SessionWrapper obj) -> IO Bool
 goodSession timeout (_, session) = do
     st <- readMVar (sessionLastTouched session)
     ct <- getCurrentTime 
@@ -113,19 +113,17 @@
     Adds a 'Session' and associated cookie.  This always sets a new
     blank session, so should only be used when there is no session already.
 -}
-addSession :: MonadSnap m => MemorySessionManager obj -> m (Session obj)
+addSession :: MonadSnap m => MemorySessionManager obj -> m (SessionWrapper obj)
 addSession (MemorySessionManager _ sref def) = do
     client <- fmap rqRemoteAddr getRequest
     (k, session) <- liftIO $ do
         smap    <- takeMVar sref
         k       <- uniqueKey smap
         ct      <- getCurrentTime
-        session <- Session client <$> newMVar ct <*> (newMVar =<< def)
+        session <- SessionWrapper client <$> newMVar ct <*> (newMVar =<< def)
         putMVar sref (M.insert k session smap)
         return (k, session)
-    let cookie = Cookie "sessionid" (B.pack $ show k) Nothing Nothing Nothing
-    modifyRequest  $ \r -> r { rqCookies = cookie : rqCookies r }
-    modifyResponse $ addCookie cookie
+    setCookie $ Cookie "sessionid" (B.pack $ show k) Nothing Nothing Nothing
     return session
 
 {-
@@ -134,7 +132,7 @@
 -}
 getExistingSession :: MonadSnap m
                    => MemorySessionManager obj
-                   -> m (Maybe (Session obj))
+                   -> m (Maybe (SessionWrapper obj))
 getExistingSession (MemorySessionManager oref sref _) = do
     liftIO (readMVar oref) >>= flip unless mzero
     cookies <- fmap rqCookies getRequest
@@ -148,28 +146,35 @@
                 Just s  -> do
                     if client /= sessionClient s
                         then return Nothing
-                        else liftIO $ do
-                            _ <- swapMVar (sessionLastTouched s) =<< getCurrentTime
-                            return (Just s)
+                        else return (Just s)
 
 {-|
     Ensures that there is a 'Session' in place, and returns it.  Adds a blank
     one if necessary.  This also updates the last touched time for the session,
     preventing it from being removed by the reaper thread for a while.
 -}
-getSession :: MonadSnap m => MemorySessionManager obj -> m (Session obj)
-getSession mgr = maybe (addSession mgr) return =<< getExistingSession mgr
+getAnySession :: MonadSnap m
+              => MemorySessionManager obj
+              -> m (SessionWrapper obj)
+getAnySession mgr = maybe (addSession mgr) return =<< getExistingSession mgr
 
 instance HasMemorySessionManager s => MonadSession (SnapExtend s) where
     type SessionValue (SnapExtend s) = MemorySessionValue s
-    getSessionObject = do
+    getSession = do
         mgr <- asks memorySessionMgr
-        ses <- getSession mgr
+        ses <- getAnySession mgr
         liftIO $ readMVar $ sessionObject ses
 
-    putSessionObject val = do
+    putSession val = do
         mgr <- asks memorySessionMgr
-        ses <- getSession mgr
-        _   <- liftIO $ swapMVar (sessionObject ses) val
+        ses <- getAnySession mgr
+        _   <- liftIO $ swapMVar (sessionLastTouched ses) =<< getCurrentTime
+        _   <- liftIO $ swapMVar (sessionObject      ses) val
+        return ()
+
+    touchSession = do
+        mgr <- asks memorySessionMgr
+        ses <- getAnySession mgr
+        liftIO $ swapMVar (sessionLastTouched ses) =<< getCurrentTime
         return ()
 
diff --git a/src/Snap/Extension/SessionUtil.hs b/src/Snap/Extension/SessionUtil.hs
deleted file mode 100644
--- a/src/Snap/Extension/SessionUtil.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings          #-}
-
-module Snap.Extension.SessionUtil where
-
-import Data.Word
-import Snap.Iteratee hiding (map)
-import Snap.Types hiding (redirect)
-import System.Random
-
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-
-import Data.Map (Map)
-import qualified Data.Map as M
-
-{-|
-    If there is another path component in the request path, pop it off, and
-    pass it as a parameter to the handler.
--}
-popPathTo :: MonadSnap m => (ByteString -> m a) -> m a
-popPathTo handler = do
-    req <- getRequest
-    let (x,y) = B.break (== '/') (rqPathInfo req)
-    if B.null x
-        then pass
-        else localRequest (\r -> r {rqPathInfo = B.drop 1 y}) (handler x)
-
-{-
-    Temporarily here, in the hopes that the type of the original will be fixed
-    in a future version of Snap.
--}
-redirect :: MonadSnap m => ByteString -> m a
-redirect target = do
-    r <- getResponse
-    finishWith
-        $ setResponseCode 302
-        $ setContentLength 0
-        $ modifyResponseBody (const $ enumBS "")
-        $ setHeader "Location" target r
-
-{-|
-    Ensure that we're at the top level of a request, and expect that it be a
-    directory.  As with standard HTTP behavior, if a path to a directory is
-    given and the request URI doesn't end in a slash, then the user is
-    redirected to a path ending in a slash.
--}
-ifTopDir :: MonadSnap m => m a -> m a
-ifTopDir handler = ifTop $ do
-    req <- getRequest
-    if (B.last (rqURI req) /= '/')
-        then redirect $ rqURI req `B.append` "/" `B.append` rqQueryString req
-        else handler
-
-{-|
-    Ensure that we're at the top level of a request, and expect that it be a
-    file.  If a trailing slash is given, we pass on the request.
--}
-ifTopFile :: MonadSnap m => m a -> m a
-ifTopFile handler = ifTop $ do
-    req <- getRequest
-    if (B.last (rqURI req) == '/') then pass else handler
-
-{-|
-    Session keys are 64-bit integers with standard numeric type classes.
--}
-newtype SessionKey = K Word64
-    deriving (Eq, Ord, Enum, Bounded, Num, Real, Integral)
-
-instance Random SessionKey where
-    randomR (l, h) g = let (r, g') = randomR (toInteger l, toInteger h) g
-                       in  (fromInteger r, g')
-    random           = randomR (minBound, maxBound)
-
-instance Show SessionKey where
-    show (K n) = show n
-
-instance Read SessionKey where
-    readsPrec n s = map (\(a,t) -> (K a, t)) (readsPrec n s)
-
-{-|
-    Generates a random key that is not already used in the given map.  Though
-    not technically speaking guaranteed to terminate, this should be fast in
-    practice.
--}
-uniqueKey :: (Random k, Ord k) => Map k a -> IO k
-uniqueKey m = do k <- randomIO
-                 if M.member k m then uniqueKey m else return k
-
diff --git a/src/Snap/SessionUtil.hs b/src/Snap/SessionUtil.hs
new file mode 100644
--- /dev/null
+++ b/src/Snap/SessionUtil.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+module Snap.SessionUtil where
+
+import Data.Word
+import Snap.Extension.Session
+import Snap.Iteratee hiding (map)
+import Snap.Types hiding (redirect)
+import System.Random
+
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+
+import Data.Map (Map)
+import qualified Data.Map as M
+
+{-|
+    Sets a cookie in both the request and the response.  This modifies the
+    list of cookies in the request, so that later attempts to get cookies will
+    find this one even within the same request.
+-}
+setCookie :: MonadSnap m => Cookie -> m ()
+setCookie cookie = do
+    modifyRequest  req
+    modifyResponse (updateHeaders (M.update cleanRsp "Set-Cookie"))
+    modifyResponse (addCookie cookie)
+  where
+    req      = \r -> r { rqCookies = cookie : cleanReq (rqCookies r) }
+    cleanReq = filter ((/= cookieName cookie) . cookieName)
+    cleanRsp = Just . filter (not . ((cookieName cookie `B.append` "=") `B.isPrefixOf`))
+
+{-|
+    If there is another path component in the request path, pop it off, and
+    pass it as a parameter to the handler.
+-}
+popPathTo :: MonadSnap m => (ByteString -> m a) -> m a
+popPathTo handler = do
+    req <- getRequest
+    let (x,y) = B.break (== '/') (rqPathInfo req)
+    if B.null x
+        then pass
+        else localRequest (\r -> r {rqPathInfo = B.drop 1 y}) (handler x)
+
+{-|
+    Temporarily here, in the hopes that the type of the original will be fixed
+    in a future version of Snap.
+-}
+redirect :: MonadSnap m => ByteString -> m a
+redirect target = do
+    r <- getResponse
+    finishWith
+        $ setResponseCode 302
+        $ setContentLength 0
+        $ modifyResponseBody (const $ enumBS "")
+        $ setHeader "Location" target r
+
+{-|
+    Ensure that we're at the top level of a request, and expect that it be a
+    directory.  As with standard HTTP behavior, if a path to a directory is
+    given and the request URI doesn't end in a slash, then the user is
+    redirected to a path ending in a slash.
+-}
+ifTopDir :: MonadSnap m => m a -> m a
+ifTopDir handler = ifTop $ do
+    req <- getRequest
+    if (B.last (rqURI req) /= '/')
+        then redirect $ rqURI req `B.append` "/" `B.append` rqQueryString req
+        else handler
+
+{-|
+    Ensure that we're at the top level of a request, and expect that it be a
+    file.  If a trailing slash is given, we pass on the request.
+-}
+ifTopFile :: MonadSnap m => m a -> m a
+ifTopFile handler = ifTop $ do
+    req <- getRequest
+    if (B.last (rqURI req) == '/') then pass else handler
+
+{-|
+    Insert this into your routes to renew sessions on each request.
+-}
+inSession :: MonadSession m => m a -> m a
+inSession handler = touchSession >> handler
+
+{-|
+    Session keys are 64-bit integers with standard numeric type classes.
+-}
+newtype SessionKey = K Word64
+    deriving (Eq, Ord, Enum, Bounded, Num, Real, Integral)
+
+instance Random SessionKey where
+    randomR (l, h) g = let (r, g') = randomR (toInteger l, toInteger h) g
+                       in  (fromInteger r, g')
+    random           = randomR (minBound, maxBound)
+
+instance Show SessionKey where
+    show (K n) = show n
+
+instance Read SessionKey where
+    readsPrec n s = map (\(a,t) -> (K a, t)) (readsPrec n s)
+
+{-|
+    Generates a random key that is not already used in the given map.  Though
+    not technically speaking guaranteed to terminate, this should be fast in
+    practice.
+-}
+uniqueKey :: (Random k, Ord k) => Map k a -> IO k
+uniqueKey m = do k <- randomIO
+                 if M.member k m then uniqueKey m else return k
+