diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,28 @@
+Copyright (c) Sebastiaan Visser 2008
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,6 @@
+#! /usr/bin/env runhaskell
+
+>import Distribution.Simple
+
+>main = defaultMain
+
diff --git a/salvia-sessions.cabal b/salvia-sessions.cabal
new file mode 100644
--- /dev/null
+++ b/salvia-sessions.cabal
@@ -0,0 +1,33 @@
+Name:               salvia-sessions
+Version:            1.0.0
+Description:        Session support for the Salvia webserver.
+Synopsis:           Session support for the Salvia webserver.
+Cabal-version:      >= 1.6
+Category:           Network, Web
+License:            BSD3
+License-file:       LICENSE
+Author:             Sebastiaan Visser, Erik Hesselink
+Maintainer:         sfvisser@cs.uu.nl
+Build-Type:         Simple
+
+Library
+  GHC-Options:      -Wall -fno-warn-orphans
+  HS-Source-Dirs:   src
+
+  Build-Depends:    base ==4.*,
+                    safe ==0.2.*,
+                    fclabels ==0.4.*,
+                    pureMD5 ==1.0.*,
+                    stm ==2.1.*,
+                    containers >= 0.2 && < 0.4,
+                    MaybeT-transformers == 0.1.*,
+                    random ==1.0.*,
+                    time ==1.1.*,
+                    utf8-string ==0.3.*,
+                    salvia ==1.0.*,
+                    salvia-protocol ==1.0.*,
+                    monads-fd ==0.0.*
+
+  Exposed-modules:  Network.Salvia.Handler.Login
+                    Network.Salvia.Handler.Session
+
diff --git a/src/Network/Salvia/Handler/Login.hs b/src/Network/Salvia/Handler/Login.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Salvia/Handler/Login.hs
@@ -0,0 +1,287 @@
+{-# LANGUAGE
+    FlexibleContexts
+  , FlexibleInstances
+  , UndecidableInstances
+  , TemplateHaskell
+  , ScopedTypeVariables
+  , TypeOperators
+  , RankNTypes
+  , MultiParamTypeClasses
+  , FunctionalDependencies
+  #-}
+module Network.Salvia.Handler.Login
+(
+-- * Basic types.
+
+  Username
+, Password
+, Email
+, Action
+, User (User)
+, email
+, username
+, password
+, actions
+
+-- * Login server aspect.
+
+, LoginM (..)
+
+-- * User Sessions.
+
+, UserPayload (..)
+, UserSession
+
+-- * User database backend.
+
+, UserDatabase (UserDatabase)
+, users
+, backend
+
+, Backend (..)
+, noBackend
+, fileBackend
+
+-- * Handlers.
+
+, hGetUser
+, hSignup
+, hLogin
+, hLogout
+, hLoginfo
+, hAuthorized
+
+)
+where
+
+import Control.Applicative
+import Control.Concurrent.STM
+import Control.Monad.State hiding (get)
+import Data.ByteString.Lazy.UTF8 hiding (lines)
+import Data.Digest.Pure.MD5
+import Data.List
+import Data.Maybe
+import Data.Record.Label
+import Network.Protocol.Http
+import Network.Protocol.Uri
+import Network.Salvia.Handler.Body
+import Network.Salvia.Handler.Session
+import Network.Salvia.Impl.Handler
+import Network.Salvia.Interface
+import Prelude hiding (mod)
+import Safe
+import qualified Control.Monad.State as S
+
+{- |
+User containg a username, password and a list of actions this user is allowed
+to perform within the system.
+-}
+
+type Username = String
+type Email    = String
+type Password = String
+type Action   = String
+
+data User = User
+  { _username :: Username
+  , _email    :: Email
+  , _password :: Password
+  , _actions  :: [Action]
+  } deriving (Eq, Show)
+
+$(mkLabels [''User])
+
+username :: User :-> Username
+email    :: User :-> Email
+password :: User :-> Password
+actions  :: User :-> [Action]
+
+{- |
+A user payload instance contains user related session information and can be
+used as the payload for regular sessions. It contains a reference to the user
+it belongs to, a flag to indicate whether the user is logged in or not and a
+possible user specific session payload.
+-}
+
+data UserPayload a = UserPayload
+  { upUser     :: User
+  , upLoggedIn :: Bool
+  , upPayload  :: Maybe a
+  } deriving (Eq, Show)
+
+type UserSession a = Session (UserPayload a)
+
+data Backend = Backend
+  { read :: MonadIO m => m UserDatabase
+  , add  :: MonadIO m => User -> m ()
+  }
+
+{- |
+A user database containing a list of users and a reference to the backend the
+database originates from and can be synchronized back to.
+-}
+
+data UserDatabase = UserDatabase
+  { _backend :: Backend
+  , _users   :: [User]
+  }
+
+$(mkLabels [''UserDatabase])
+
+users   :: UserDatabase :-> [User]
+backend :: UserDatabase :-> Backend
+
+class (Applicative m, Monad m) => LoginM p m | m -> p where
+  login      ::                  m a -> (User -> m a) -> m a
+  loginfo    ::                                          m ()
+  logout     ::                                          m ()
+  signup     :: [Action]      -> m a -> (User -> m a) -> m a
+  authorized :: Maybe Action  -> m a -> (User -> m a) -> m a
+
+instance ( Contains q (TVar (Sessions (UserPayload p)))
+         , Contains q (TVar UserDatabase)
+         ) => LoginM p (Handler q) where
+  login      = hLogin      (undefined :: p)
+  logout     = hLogout     (undefined :: p)
+  loginfo    = hLoginfo    (undefined :: p)
+  signup     = hSignup     (undefined :: p)
+  authorized = hAuthorized (undefined :: p)
+
+hGetUser :: LoginM p m => m (Maybe User)
+hGetUser = authorized Nothing (return Nothing) (return . Just)
+
+{- |
+The signup handler is used to create a new entry in the user database. It reads
+a new username and password from the post parameters and adds a new entry into
+the backend of the user database when no user with such name exists. The user
+gets the specified initial set of actions assigned. When the signup fails the
+first handler will be executed when the signup succeeds the second handler will
+be executed which may access the fresh user object.
+-}
+
+hSignup
+  :: forall m q p a. (MonadIO m, PayloadM q UserDatabase m, SessionM (UserPayload p) m, BodyM Request m, HttpM Request m)
+  => p -> [Action] -> m a -> (User -> m a) -> m a
+hSignup _ acts onFail onOk =
+  do ps <- hRequestParameters "utf-8"
+     join . payload $
+       do db <- S.get
+          case freshUserInfo ps (get users db) acts of
+            Nothing -> return onFail
+            Just user  -> 
+              do modM users (user:)
+                 return $
+                   do add (get backend db) user
+                      onOk user
+
+-- | Helper functions that generates fresh user information.
+
+freshUserInfo :: Parameters -> [User] -> [Action] -> Maybe User
+freshUserInfo ps us acts =
+  do user  <- "username" `lookup` ps >>= id
+     mail  <- "email"    `lookup` ps >>= id
+     pass  <- "password" `lookup` ps >>= id
+     if null user || null mail || null pass
+       then Nothing
+       else case ( headMay $ filter ((==user) . get username) us
+                 , headMay $ filter ((==mail) . get email)   us
+                 ) of
+              (Nothing, Nothing) -> return $ User user mail (show (md5 (fromString pass))) acts
+              _                  -> Nothing
+
+{- |
+The login handler. Read the username and password values from the post data and
+use that to authenticate the user. When the user can be found in the database
+the user is logged in and stored in the session payload. When the login fails
+the first handler will be executed when the login succeeds the second handler
+will be executed which may access the fresh user object.
+-}
+
+hLogin
+  :: forall m q p a. (PayloadM q UserDatabase m, SessionM (UserPayload p) m, HttpM Request m, MonadIO m, BodyM Request m)
+  => p -> m a -> (User -> m a) -> m a
+hLogin _ onFail onOk =
+  do ps <- hRequestParameters "utf-8"
+     db <- payload S.get :: m UserDatabase
+     case authenticate ps db of
+       Nothing   -> onFail
+       Just user -> do let pl = Just (UserPayload user True Nothing)
+                       withSession (set sPayload pl)
+                       onOk user
+
+-- | Helper functions that performs the authentication check.
+
+authenticate :: Parameters -> UserDatabase -> Maybe User
+authenticate ps db =
+  do user <- "username" `lookup` ps >>= id
+     pass <- "password" `lookup` ps >>= id
+     case headMay $ filter ((==user) . get username) (get users db) of
+       Just u | get password u == show (md5 (fromString pass)) -> Just u
+       _                                                       -> Nothing
+
+-- | Logout the current user by emptying the session payload.
+
+hLogout :: SessionM (UserPayload p) m => p -> m ()
+hLogout _ = withSession (set sPayload Nothing)
+
+{- |
+The `loginfo' handler exposes the current user session to the world using a
+simple text based response. The response contains information about the current
+session identifier, session start and expiration date and the possible user
+payload that is included.
+-}
+
+hLoginfo :: (SessionM (UserPayload p) m, SendM m) => p -> m ()
+hLoginfo _ =
+  do hSessionInfo
+     s <- getSession
+     case get sPayload s of
+       Nothing -> return ()
+       Just (UserPayload (User uname mail _ acts) _ _) ->
+         do send $ "\n" ++ intercalate "\n"
+              [ "username=" ++ uname
+              , "mail="     ++ mail
+              , "actions="  ++ intercalate " " acts
+              ]
+
+{- |
+Execute a handler only when the user for the current session is authorized to
+do so. The user must have the specified action contained in its actions list in
+order to be authorized. When the authorization fails the first handler will be
+executed when the authorization succeeds the second handler will be executed
+which may access the current user object. 
+-}
+
+hAuthorized :: SessionM (UserPayload p) m => p -> Maybe Action -> m b -> (User -> m b) -> m b
+hAuthorized _ maction onFail onOk =
+  do session <- getSession
+     case (maction, get sPayload session) of
+       (Nothing,     Just (UserPayload user _ _))                                  -> onOk user
+       (Just action, Just (UserPayload user _ _)) | action `elem` get actions user -> onOk user
+       _                                                                           -> onFail
+
+-- | User database backend that does nothing and discards all changes made.
+
+noBackend :: Backend
+noBackend = let b = Backend (return (UserDatabase b [])) (const (return ())) in b
+
+-- | File based user database backend. Format: /username password action*/.
+
+fileBackend :: FilePath -> Backend
+fileBackend file = bcknd
+  where 
+    bcknd = Backend
+      ((UserDatabase bcknd . parse) `liftM` liftIO (readFile file))
+      (liftIO . appendFile file . printUserLine)
+    parse = catMaybes . map parseUserLine . lines
+    parseUserLine line =
+      case (line, words line) of
+        ('#':_,               _) -> Nothing
+        (_, user:mail:pass:acts) -> Just (User user mail pass acts)
+        _                        -> Nothing
+    printUserLine u = intercalate " " $
+      [ get username u
+      , get email u
+      , get password u
+      ] ++ get actions u ++ ["\n"]
+
diff --git a/src/Network/Salvia/Handler/Session.hs b/src/Network/Salvia/Handler/Session.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Salvia/Handler/Session.hs
@@ -0,0 +1,248 @@
+{-# LANGUAGE
+    FlexibleContexts
+  , FlexibleInstances
+  , UndecidableInstances
+  , TemplateHaskell
+  , TypeOperators
+  , ScopedTypeVariables
+  , GeneralizedNewtypeDeriving
+  , MultiParamTypeClasses
+  , FunctionalDependencies
+ #-}
+module Network.Salvia.Handler.Session where
+
+import Control.Applicative hiding (empty)
+import Control.Category
+import Control.Concurrent.STM hiding (check)
+import Control.Monad.Maybe
+import Control.Monad.State hiding (get, sequence)
+import Data.List
+import Data.Maybe
+import Data.Record.Label
+import Data.Time.Clock
+import Data.Time.LocalTime
+import Network.Protocol.Cookie hiding (empty)
+import Network.Protocol.Http hiding (cookie)
+import Network.Salvia.Handler.Cookie
+import Network.Salvia.Impl.Handler
+import Network.Salvia.Interface
+import Prelude hiding ((.), id, lookup, sequence, mod)
+import Safe
+import System.Random
+import qualified Control.Monad.State as S
+import qualified Data.Map as M
+
+-- | A session identifier. Should be unique for every session.
+
+newtype SessionID = SID { _sid :: Integer }
+  deriving (Eq, Ord, Random)
+
+$(mkLabels [''SessionID])
+
+sid :: SessionID :-> Integer
+
+instance Show SessionID where
+  show = show . get sid
+
+-- | The session data type with polymorphic payload.
+
+data Session p =
+  Session
+  { _sID      :: SessionID
+  , _sStart   :: UTCTime
+  , _sLast    :: UTCTime
+  , _sExpire  :: Integer
+  , _sPayload :: Maybe p
+  } deriving (Show)
+
+$(mkLabels [''Session])
+
+-- | A globally unique session identifier.
+sID :: Session p :-> SessionID
+
+-- | The time the session started.
+sStart :: Session p :-> UTCTime
+
+-- | Last time session was used.
+sLast :: Session p :-> UTCTime
+
+-- | Expire after this amount of time when unused.
+sExpire :: Session p :-> Integer
+
+-- | The information this session stores.
+sPayload :: Session p :-> Maybe p
+
+-- | Session type classes that hides the inner workings from the outside world.
+
+class (Applicative m, Monad m) => SessionM p m | m -> p where
+  prolongSession :: Integer -> m ()
+  getSession     :: m (Session p)
+  putSession     :: Session p -> m ()
+  delSession     :: m ()
+  withSession    :: (Session p -> Session p) -> m ()
+
+-- | Default instance for the `Handler' context.
+
+instance Contains q (TVar (Sessions p)) => SessionM p (Handler q) where
+  prolongSession = hProlongSession (undefined :: p)
+  getSession     = hGetSession
+  putSession     = hPutSession
+  delSession     = hDelSession     (undefined :: p)
+  withSession    = hWithSession
+
+-- | A mapping from unique session IDs to shared session variables.
+
+type SessionMap p = M.Map SessionID (TVar (Session p))
+newtype Sessions p = Sessions { unSessions :: SessionMap p }
+
+-- | Apply a function to the sessions in the `Sessions` newtype.
+
+withSessions :: (SessionMap p -> SessionMap p) -> Sessions p -> Sessions p
+withSessions f = Sessions . f . unSessions
+
+-- | Create a new, empty, store of sessions.
+
+mkSessions :: Sessions p
+mkSessions = Sessions M.empty
+
+{- | todo doc:
+The session handler. This handler will try to return an existing session from
+the sessions map based on a session identifier found in the HTTP `cookie`. When
+such a session can be found the expiration date will be updated to a number of
+seconds in the future. When no session can be found a new one will be created.
+A cookie will be set that informs the client of the current session.
+-}
+
+hProlongSession
+  :: forall m q p. (MonadIO m, HttpM' m, ServerM m, ServerAddressM m, PayloadM q (Sessions p) m)
+  => p -> Integer -> m ()
+hProlongSession _ e =
+  do n <- liftIO getCurrentTime
+     var <- existingSessionVarOrNew
+     session <- modVar (set sLast n . set sExpire e) (var :: TVar (Session p)) >>= getVar
+     setCookieSession (get sID session) (willExpireAt session)
+
+hGetSession :: (MonadIO m, HttpM' m, ServerM m, PayloadM q (Sessions p) m) => m (Session p)
+hGetSession = existingSessionVarOrNew >>= getVar
+
+hPutSession
+  :: (MonadIO m, HttpM' m, ServerM m, ServerAddressM m, PayloadM q (Sessions p) m)
+  => Session p -> m ()
+hPutSession session =
+  do var <- existingSessionVarOrNew
+     putVar var session
+     setCookieSession (get sID session) (willExpireAt session)
+
+hDelSession :: forall q p m. (PayloadM q (Sessions p) m, HttpM' m, MonadIO m) => p -> m ()
+hDelSession _ =
+  do msid <- getCookieSessionID
+     case msid of
+       Just sd ->
+         do delCookieSession
+            payload . S.modify . withSessions $ (M.delete sd :: SessionMap p -> SessionMap p)
+       Nothing -> return ()
+
+hWithSession
+  :: (PayloadM q (Sessions p) m, MonadIO m, HttpM Request m)
+  => (Session p -> Session p) -> m ()
+hWithSession f =
+  do _ <- existingSessionVarOrNew >>= modVar f
+     return ()
+
+hSessionInfo :: (SessionM p m, SendM m) => m ()
+hSessionInfo =
+  do s <- getSession
+     (send . intercalate "\n")
+       [ "id="      ++ show (get sID     s)
+       , "start="   ++ show (get sStart  s)
+       , "last="    ++ show (get sLast   s)
+       , "expire="  ++ show (get sExpire s)
+       , "payload=" ++ show (isJust $ get sPayload s)
+       ]
+
+{- | todo:
+Given an existing session identifier lookup a session from the session map.
+When no session is available, or the session is expired, create a new one using
+the `newSessionVar' function. Otherwise the expiration date of the existing
+session is updated.
+-}
+
+existingSessionVarOrNew
+  :: (Applicative m, MonadIO m, HttpM Request m, PayloadM q (Sessions p) m)
+  => m (TVar (Session p))
+existingSessionVarOrNew = fromMaybeTM newSessionVar $
+  do sd  <- MaybeT getCookieSessionID
+     svar <- MaybeT (lookupSessionVar sd)
+     MaybeT (whenNotExpired svar)
+
+whenNotExpired :: MonadIO m => TVar (Session p) -> m (Maybe (TVar (Session p)))
+whenNotExpired var =
+  do n <- liftIO getCurrentTime
+     session <- getVar var
+     return $ if (willExpireAt session > n) then Just var else Nothing
+
+{- |
+This handler sets the HTTP cookie for the specified session. It will
+use a default cookie with an additional `sid' attribute with the
+session identifier as value. The session expiration date will be used
+as the cookie expire field. The session is valid for all subdomains.
+-}
+
+setCookieSession :: (MonadIO m, ServerM m, ServerAddressM m, HttpM Response m) => SessionID -> UTCTime -> m ()
+setCookieSession sd ex =
+  do zone <- liftIO getCurrentTimeZone
+     let time = utcToLocalTime zone ex
+     ck <- set name "sid" . set value (show sd) <$> hNewCookie time True
+     hSetCookie (fromList [ck])
+
+-- | Given the (possibly wrong) request cookie, try to recover the existing
+-- session identifier.
+
+getCookieSessionID :: (MonadIO m, HttpM Request m) => m (Maybe SessionID)
+getCookieSessionID =
+  -- todo : join . fmap == (=<<)
+  fmap SID . join . fmap readMay . join . fmap (get (fmapL value . pickCookie "sid"))
+     <$> hCookie
+
+delCookieSession :: HttpM Response m => m ()
+delCookieSession = hDelCookie "sid"
+
+-- | Create a new session with a specified expiration date. The session will be
+-- stored in the session map.
+
+newSessionVar :: (MonadIO m, PayloadM q (Sessions p) m) => m (TVar (Session p))
+newSessionVar = do
+  t <- liftIO getCurrentTime
+  session <- newVar (Session undefined t t 0 Nothing)
+  keys <- liftIO newStdGen >>= return . randoms
+  sd <- payload $ do
+    sd <- newSessionID keys
+    S.modify . withSessions $ M.insert sd session
+    return sd
+  modVar (set sID sd) session
+
+newSessionID :: (MonadState (Sessions p) m, Functor m) => [SessionID] -> m SessionID
+newSessionID keys =
+  do store <- unSessions <$> S.get
+     return . head . filter (flip M.notMember store) $ keys
+
+willExpireAt :: Session p -> UTCTime
+willExpireAt session = fromInteger (get sExpire session) `addUTCTime` get sLast session 
+
+lookupSessionVar
+  :: (MonadIO m, PayloadM q (Sessions p) m)
+  => SessionID -> m (Maybe (TVar (Session p)))
+lookupSessionVar sd = payload (S.gets (M.lookup sd . unSessions))
+
+-- STM utilities.
+
+newVar :: MonadIO m => a -> m (TVar a)
+getVar :: MonadIO m => TVar a -> m a
+putVar :: MonadIO m => TVar a -> a -> m ()
+modVar :: MonadIO m => (a -> a) -> TVar a -> m (TVar a)
+
+newVar       = liftIO . atomically . newTVar
+getVar       = liftIO . atomically . readTVar
+putVar   var = liftIO . atomically . writeTVar var
+modVar f var = liftIO . atomically $ (readTVar var >>= writeTVar var . f) >> return var
+