diff --git a/salvia.cabal b/salvia.cabal
--- a/salvia.cabal
+++ b/salvia.cabal
@@ -1,5 +1,5 @@
 Name:             salvia
-Version:          0.0.4
+Version:          0.0.5
 Description:      Lightweight Haskell Web Server Framework
 Synopsis:         Lightweight Haskell Web Server Framework 
 Category:         Network, Web
@@ -14,6 +14,7 @@
                   clevercss,
                   containers,
                   directory,
+                  nano-md5,
                   encoding,
                   filepath,
                   hscolour,
@@ -22,6 +23,7 @@
                   old-locale,
                   parsec,
                   process,
+                  template-haskell >= 2.2,
                   random,
                   stm,
                   time,
@@ -30,8 +32,10 @@
 Extensions:       CPP
 HS-Source-Dirs:   src
 Other-modules:    Misc.Misc,
-                  Misc.Terminal
-Exposed-modules:  Network.Protocol.Cookie,
+                  Misc.Terminal,
+                  Data.Record.Label.TH
+Exposed-modules:  Data.Record.Label,
+                  Network.Protocol.Cookie,
                   Network.Protocol.Http,
                   Network.Protocol.Mime,
                   Network.Protocol.Uri,
diff --git a/src/Data/Record/Label.hs b/src/Data/Record/Label.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Record/Label.hs
@@ -0,0 +1,86 @@
+module Data.Record.Label (
+    Getter, Setter, Modifier
+  , Label (..)
+  , lmod
+  , (%), comp
+  , getM, setM, modM
+  , bothM
+  , enterM, enterMT
+  , withM, localM
+  , list
+  , module Data.Record.Label.TH
+  ) where
+
+import Control.Monad.State
+import Data.Record.Label.TH
+
+type Getter   a b = a -> b
+type Setter   a b = b -> a -> a
+type Modifier a b = (b -> b) -> a -> a
+
+data Label a b = Label {
+    lget :: Getter a b
+  , lset :: Setter a b
+  }
+
+lmod :: Label a b -> Modifier a b
+lmod l f a = lset l (f (lget l a)) a
+
+infixr 8 %
+
+(%) :: Label t a -> Label b t -> Label b a
+a % b = Label (lget a . lget b) (lmod b . lset a)
+
+-- Apply custom `parser' and 'printer' function.
+
+comp :: (b -> c) -> (c -> b) -> Label t b -> Label t c
+comp f g (Label a b) = Label (f . a) (\v -> b $ g v)
+
+-- Extend the state monad with support for labels.
+
+getM :: MonadState s m => Label s b -> m b
+getM = gets . lget
+
+setM :: MonadState s m => Label s b -> b -> m ()
+setM l = modify . lset l
+
+modM :: MonadState s m => Label s b -> (b -> b) -> m ()
+modM l = modify . lmod l
+
+-- Run a state computation for a sub element updating this part of the state afterwards.
+
+enterM :: MonadState s m => Label s b -> State b a -> m a
+enterM l c = do
+  b <- getM l
+  let (a, s) = runState c b
+  setM l s
+  return a
+
+enterMT :: (MonadState s (t m), MonadTrans t, Monad m) => Label s b -> StateT b m a -> t m a
+enterMT l c = do
+  b <- getM l
+  (a, s) <- lift $ runStateT c b
+  setM l s
+  return a
+
+bothM :: MonadState s m => Label s b -> State b a -> m (b, a)
+bothM parent cmp = do
+  p <- getM parent
+  c <- enterM parent cmp
+  return (p, c)
+
+localM :: MonadState s m => Label s b -> m c -> m c
+localM l c = do
+  k <- getM l
+  c' <- c
+  setM l k
+  return c'
+
+withM :: MonadState s m => Label s b -> State b a -> m c -> m c
+withM l c d = localM l (enterM l c >> d)
+
+-- Lift list indexing to a label.
+
+list :: Int -> Label [a] a
+list i = Label (!! i) (\v a -> take i a ++ [v] ++ drop (i+1) a)
+
diff --git a/src/Data/Record/Label/TH.hs b/src/Data/Record/Label/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Record/Label/TH.hs
@@ -0,0 +1,47 @@
+module Data.Record.Label.TH (mkLabels) where
+
+import Control.Monad (liftM)
+import Data.Char (toLower, toUpper)
+import Language.Haskell.TH ( Body (NormalB)
+                           , Clause (Clause)
+                           , Con (RecC)
+                           , Dec (DataD, FunD)
+                           , Exp (AppE, ConE, LamE, RecUpdE, VarE)
+                           , Info (TyConI)
+                           , Name
+                           , Pat (VarP)
+                           , Q
+                           , mkName
+                           , nameBase
+                           , reify)
+import Language.Haskell.TH.Syntax (VarStrictType)
+
+mkLabels :: [Name] -> Q [Dec]
+mkLabels = liftM concat . mapM mkLabels1
+
+mkLabels1 :: Name -> Q [Dec]
+mkLabels1 n = do
+    i <- reify n
+    let cs' = case i of
+                 TyConI (DataD _ _ _ cs _) -> cs -- only process data declarations
+                 _ -> []
+        ls' = [ l | (RecC _ ls) <- cs', l <- ls ] -- we're only interested in labels of record constructors
+    return $ map mkLabel ls'
+
+mkLabel :: VarStrictType -> Dec
+mkLabel (name, _, _) =
+    -- Generate a name for the label:
+    -- * If the original selector starts with an _, remove it and make
+    --   the next character lowercase.
+    -- * Otherwise, add 'l', and make the next character uppercase.
+    let n = mkName $ case nameBase name of
+                ('_' : c : rest) -> toLower c : rest
+                (f : rest)   -> 'l' : toUpper f : rest
+                []           -> error "Data.Record.Label.TH: this should not happen."
+    in FunD n [Clause [] (NormalB (
+           AppE (AppE (ConE (mkName "Label"))
+                      (VarE name)) -- getter
+                (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter
+                      (RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))]))
+                                   )) []]
+
diff --git a/src/Misc/Misc.hs b/src/Misc/Misc.hs
--- a/src/Misc/Misc.hs
+++ b/src/Misc/Misc.hs
@@ -13,10 +13,9 @@
   , intersperseS
   , trim
   , normalCase
-  , intRead
+  , safeRead
   , now
   , later
-  , safeRead
   , safeHead
   , atomModTVar
   , atomReadTVar
@@ -40,9 +39,6 @@
 safeRead s = case reads s of
   [(x, "")] -> Just x
   _         -> Nothing
-
-intRead :: String -> Maybe Int
-intRead = safeRead
 
 -- Conversions.
 
diff --git a/src/Network/Protocol/Cookie.hs b/src/Network/Protocol/Cookie.hs
--- a/src/Network/Protocol/Cookie.hs
+++ b/src/Network/Protocol/Cookie.hs
@@ -10,15 +10,14 @@
   , parseCookies
   ) where
 
-import Control.Monad ()
 import Control.Applicative hiding (empty)
+import Control.Monad ()
 import Data.Char (toLower)
 import Data.List (intercalate)
-import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
-import qualified Data.Map as M
-
 import Misc.Misc (intersperseS, (@@), trim)
 import Network.Protocol.Uri (URI)
+import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
+import qualified Data.Map as M
 
 -- For more information:
 -- http://www.ietf.org/rfc/rfc2109.txt
diff --git a/src/Network/Protocol/Http.hs b/src/Network/Protocol/Http.hs
--- a/src/Network/Protocol/Http.hs
+++ b/src/Network/Protocol/Http.hs
@@ -1,46 +1,41 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}
 
 module Network.Protocol.Http(
 
     Status (..)
   , Method (..)
   , methods
-  , Version (..)
+  , Version
   , Headers
-  , Direction (..)
-  , Message (..)
+  , Direction
+  , Message
 
+  , major
+  , minor
+  , method
+  , uri
+  , status
+  , direction
+  , version
+  , headers
+  , body
+
   , utf8
   , http10
   , http11
   , emptyRequest
   , emptyResponse
 
-  , method
-  , setMethod
-  , uri
-  , setUri
-  , modUri
-  , status
-  , setStatus
-  , setVersion
-  , setBody
-  , modBody
-  , header
-  , setHeader
-  , modHeader
-  , getLocation
-  , getHost
-  , getContentLength
-  , getKeepAlive
-  , getCookie
-  , setContentType
-  , setContentLength
-  , setLocation
-  , setDate
-  , setServer
-  , setCookie
   , normalizeHeader
+  , header
+  , contentLength
+  , keepAlive
+  , cookie
+  , location
+  , contentType
+  , date
+  , server
+  , hostname
 
   , pRequest
   , pResponse
@@ -59,14 +54,13 @@
 import Data.Char
 import Data.List (intercalate)
 import Data.Maybe (fromMaybe)
+import Data.Record.Label
+import Misc.Misc
+import Network.Protocol.Uri (URI, mkURI, pUriReference, parseURI)
 import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
 import qualified Data.Bimap as Bm
 import qualified Data.Map as M
 
-import Misc.Misc
-import Network.Protocol.Uri (URI, mkURI, pUriReference)
-import Network.Protocol.Cookie ()
-
 -------- HTTP message data-types ----------------------------------------------
 
 data Status =
@@ -107,111 +101,106 @@
 methods :: [Method]
 methods = [OPTIONS, GET, HEAD, POST, PUT, DELETE, TRACE, CONNECT]
 
-data Version = Version {major :: Int, minor :: Int}
-type Headers = M.Map String String
+data Version = Version {_major :: Int, _minor :: Int}
 
+type HeaderKey   = String
+type HeaderValue = String
+type Headers     = M.Map HeaderKey HeaderValue
+
 data Direction =
-    Request  {_method :: Method, _uri :: URI}
-  | Response {_status :: Status}
+    Request  {__method :: Method, __uri :: URI}
+  | Response {__status :: Status}
 
 data Message =
   Message {
-    direction :: Direction
-  , version :: Version
-  , headers :: Headers
-  , body :: String
+    _direction :: Direction
+  , _version   :: Version
+  , _headers   :: Headers
+  , _body      :: String
   }
 
-utf8 :: String
-utf8 = "utf-8"
-
--------- HTTP message creation and alteration ---------------------------------
-
--- Create HTTP versions.
-http10, http11 :: Version
-http10 = Version 1 0
-http11 = Version 1 1
-
-emptyRequest :: Message
-emptyRequest = Message (Request GET (mkURI)) http11 M.empty ""
-
-emptyResponse :: Message
-emptyResponse = Message (Response OK) http11 M.empty ""
-
-method :: Message -> Method
-method = _method . direction
-
-setMethod :: Method -> Message -> Message
-setMethod e m = m { direction = Request e (uri m) }
-
-uri :: Message -> URI
-uri = _uri . direction
-
-setUri :: URI -> Message -> Message
-setUri u m = m { direction = Request (method m) u }
-
-modUri :: (URI -> URI) -> Message -> Message
-modUri f m = setUri (f $ uri m) m
+$(mkLabels [''Version, ''Direction, ''Message])
 
-status :: Message -> Status
-status = _status . direction
+major     :: Label Version   Int
+minor     :: Label Version   Int
+body      :: Label Message   String
+headers   :: Label Message   Headers
+version   :: Label Message   Version
+direction :: Label Message   Direction
+_status   :: Label Direction Status
+_uri      :: Label Direction URI
+_method   :: Label Direction Method
 
-setStatus :: Status -> Message -> Message
-setStatus s m = m { direction = Response s }
+-- Public labels based on private labels.
 
-setVersion :: Version -> Message -> Message
-setVersion v m = m { version = v }
+method :: Label Message Method
+method = _method % direction
 
-setBody :: String -> Message -> Message
-setBody b m = m { body = b }
+uri :: Label Message URI
+uri = _uri % direction
 
-modBody :: (String -> String) -> Message -> Message
-modBody f m = setBody (f $ body m) m
+status :: Label Message Status
+status = _status % direction
 
-header :: String -> Message -> String
-header k = maybe "" id . M.lookup (normalizeHeader k) . headers
+-- More advanced labels.
 
-setHeader :: String -> String -> Message -> Message
-setHeader k a (Message r v h b) = Message r v (M.insert (normalizeHeader k) a h) b
+normalizeHeader :: String -> String
+normalizeHeader = (intercalate "-") . (map normalCase) . (Misc.Misc.split '-')
 
-modHeader :: String -> (String -> String) -> Message -> Message
-modHeader k f m = setHeader k (f $ header k m) m
+header :: HeaderKey -> Label Message HeaderValue
+header key =
+  Label {
+    lget = maybe "" id . M.lookup (normalizeHeader key) . lget headers
+  , lset = lmod headers . M.insert (normalizeHeader key)
+  }
 
-getLocation :: Message -> String
-getLocation = header "Location"
+contentLength :: Label Message (Maybe Integer)
+contentLength = comp safeRead (maybe "" show) (header "Content-Length")
 
-getHost :: Message -> String
-getHost = header "Host"
+keepAlive :: Label Message (Maybe Integer)
+keepAlive = comp safeRead (maybe "" show) (header "Keep-Alive")
 
-getContentLength :: Message -> Maybe Int
-getContentLength = intRead . header "Content-Length"
+cookie :: Label Message String
+cookie =
+  Label {
+    lget = lget (header "Cookie")
+  , lset = lset (header "Set-Cookie")
+  }
 
-getKeepAlive :: Message -> Maybe Int
-getKeepAlive = intRead . header "Keep-Alive"
+location :: Label Message (Maybe URI)
+location =
+  Label {
+    lget = parseURI . lget (header "Location")
+  , lset = lset (header "Location") . maybe "" show
+  }
 
-getCookie :: Message -> String
-getCookie = header "Cookie"
+contentType :: Label Message (String, Maybe String)
+contentType = comp pa pr (header "Content-Length")
+  where pr (t, c) = t ++ maybe "" ("; charset="++) c
+        pa = error "no getter for contentType yet"
 
-setContentType :: String -> Maybe String -> Message -> Message
-setContentType t c = setHeader "Content-Type" (t ++ maybe "" ("; charset="++) c)
+date :: Label Message String
+date = header "Date"
 
-setContentLength :: Num a => a -> Message -> Message
-setContentLength l = setHeader "Content-Length" (show l)
+hostname :: Label Message String
+hostname = header "Host"
 
-setLocation :: URI -> Message -> Message
-setLocation l = setHeader "Location" (show l)
+server :: Label Message String
+server = header "Server"
 
-setDate :: String -> Message -> Message
-setDate d = setHeader "Date" d
+-- Create HTTP versions.
+http10, http11 :: Version
+http10 = Version 1 0
+http11 = Version 1 1
 
-setServer :: String -> Message -> Message
-setServer n  = setHeader "Server" n
+emptyRequest :: Message
+emptyRequest = Message (Request GET (mkURI)) http11 M.empty ""
 
-setCookie :: String -> Message -> Message
-setCookie c = setHeader "Set-Cookie" c
+emptyResponse :: Message
+emptyResponse = Message (Response OK) http11 M.empty ""
 
-normalizeHeader :: String -> String
-normalizeHeader = (intercalate "-") . (map normalCase) . (Misc.Misc.split '-')
+utf8 :: String
+utf8 = "utf-8"
 
 -------- HTTP message parsing -------------------------------------------------
 
@@ -279,7 +268,7 @@
   concat [show m, " ", show u, " ", showVersion v, lf, showHeaders hs, lf, lf]
 
 instance Show Message where
-  show m = concat [showMessageHeader m, body m]
+  show m = concat [showMessageHeader m, lget body m]
 
 -------- status code mappings -------------------------------------------------
 
diff --git a/src/Network/Protocol/Uri.hs b/src/Network/Protocol/Uri.hs
--- a/src/Network/Protocol/Uri.hs
+++ b/src/Network/Protocol/Uri.hs
@@ -1,9 +1,10 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 module Network.Protocol.Uri (
 
-    URI (..)
+    URI
   , Scheme
   , IPv4
-  , Label
   , Domain
   , RegName
   , Port
@@ -13,9 +14,9 @@
   , UserInfo
   , PathSegment
   , Parameters
-  , Path (..)
-  , Host (..)
-  , Authority (..)
+  , Path
+  , Host
+  , Authority
 
   , encode
   , decode
@@ -30,34 +31,21 @@
   , mkHost
   , mkPort
 
+  , absolute
+  , segments
+  , domain
+  , regname
+  , ipv4
+  , userinfo
+  , host
+  , port
+  , relative
   , scheme
   , authority
   , path
   , query
   , fragment
-  , userinfo
-  , host
-  , port
-  , domains
-  , pathSegments
 
-  , setScheme
-  , setAuthority
-  , setPath
-  , setQuery
-  , setFragment
-  , setUserinfo
-  , setHost
-  , setPort
-
-  , modScheme
-  , modAuthority
-  , modPath
-  , modQuery
-  , modUserinfo
-  , modHost
-  , modPort
-
   , parseURI
   , parseAbsoluteURI
   , parseAuthority
@@ -74,10 +62,8 @@
   , queryParams
 
   , extension
-  , setExtension
-  , modExtension
 
-  , relative
+  , mkPathRelative
   , mimetype
   , normalize
   , jail
@@ -90,18 +76,17 @@
 import Data.Char (ord, chr, isDigit, isAlphaNum, intToDigit, isHexDigit)
 import Data.List (intercalate, isPrefixOf)
 import Data.Maybe (mapMaybe, fromJust)
-import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
-import System.FilePath.Posix
-
+import Data.Record.Label
+import Misc.Misc (eitherToMaybe, (@@), bool, pMaybe, split)
 import Network.Protocol.Mime
-import Misc.Misc
+import System.FilePath.Posix
+import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))
 
 -------[ data type definition of URIs ]----------------------------------------
 
 type Scheme      = String
 type IPv4        = [Int] -- actually 4-tupel
-type Label       = String
-type Domain      = [Label]
+type Domain      = [String]
 type RegName     = String
 type Port        = Int
 type Query       = String
@@ -118,15 +103,15 @@
   deriving Eq
 
 data Host =
-    Hostname { _domain  :: Domain }
-  | RegName  { _regname :: String }
-  | IPv4     { _ipv4    :: IPv4   }
+    Hostname { __domain  :: Domain }
+  | RegName  { __regname :: String }
+  | IPv4     { __ipv4    :: IPv4   }
   deriving Eq
 
 data Authority = Authority {
-    _userinfo :: UserInfo
-  , _host     :: Host
-  , _port     :: Port
+    __userinfo :: UserInfo
+  , __host     :: Host
+  , __port     :: Port
   }
   deriving Eq
 
@@ -134,20 +119,69 @@
     _relative  :: Bool
   , _scheme    :: Scheme
   , _authority :: Authority
-  , _path      :: Path
-  , _query     :: Query
+  , __path     :: Path
+  , __query     :: Query
   , _fragment  :: Fragment
   }
   deriving Eq
 
-{-
-testUri0 :: URI
-testUri0 = fromJust $ parseURI "http://sebas@hs.spugium.net:8080/wiki/first%20section/chapter-2;pdf?additional=vars"
+$(mkLabels [''Path, ''Host, ''Authority, ''URI])
 
-testUri1 :: URI
-testUri1 = fromJust $ parseURI "http://cs.uu.nl/docs/../docs/vakken/../vakken/"
--}
+_domain   :: Label Host Domain
+_host     :: Label Authority Host
+_ipv4     :: Label Host IPv4
+_path     :: Label URI Path
+_port     :: Label Authority Port
+_query    :: Label URI Query
+_regname  :: Label Host String
+_userinfo :: Label Authority UserInfo
+absolute  :: Label Path Bool
+authority :: Label URI Authority
+domain    :: Label URI Domain
+fragment  :: Label URI Fragment
+host      :: Label URI String
+ipv4      :: Label URI IPv4
+path      :: Label URI FilePath
+port      :: Label URI Port
+query     :: Label URI Query
+regname   :: Label URI String
+relative  :: Label URI Bool
+scheme    :: Label URI Scheme
+segments  :: Label Path [PathSegment]
+userinfo  :: Label URI UserInfo
 
+-- Public label based on private labels.
+
+domain    = _domain   % _host % authority
+regname   = _regname  % _host % authority
+ipv4      = _ipv4     % _host % authority
+userinfo  = _userinfo % authority
+port      = _port     % authority
+
+query =
+  Label {
+    lget = decode . lget _query
+  , lset = lset _query . encode
+  }
+
+host =
+  Label {
+    lget = show . lget (_host % authority)
+  , lset = lset (_host % authority) . fromJust . parseHost
+  }
+
+path =
+  Label {
+    lget = decode . show . lget _path
+  , lset = lset _path . fromJust . parsePath . encode
+  }
+
+-- testUri0 :: URI
+-- testUri0 = fromJust $ parseURI "http://sebas@hs.spugium.net:8080/wiki/first%20section/chapter-2.pdf?additional=vars"
+
+-- testUri1 :: URI
+-- testUri1 = fromJust $ parseURI "http://cs.uu.nl/docs/../docs/vakken/../vakken/"
+
 -------[ creating, selection and modifying URIs ]------------------------------
 
 -- pseudo constructors for `empty values'
@@ -179,84 +213,6 @@
 mkPort :: Port
 mkPort = (-1)
 
--- getter functions
-scheme :: URI -> Scheme
-scheme = _scheme
-
-authority :: URI -> String
-authority = show . _authority
-
-path :: URI -> FilePath
-path = decode . show . _path
-
-query :: URI -> Query
-query = decode . _query
-
-fragment :: URI -> Fragment
-fragment = _fragment
-
-userinfo :: URI -> UserInfo
-userinfo = _userinfo . _authority
-
-host :: URI -> String
-host = show . _host . _authority
-
-port :: URI -> Port
-port = _port . _authority
-
-domains :: URI -> Domain
-domains = _domain . _host . _authority
-
-pathSegments :: URI -> [PathSegment]
-pathSegments = _segments . _path 
-
--- setter functions
-setScheme :: Scheme -> URI -> URI
-setScheme s u = u { _scheme = s }
-
-setAuthority :: String -> URI -> URI
-setAuthority a u = u { _authority = fromJust $ parseAuthority a }
-
-setPath :: String -> URI -> URI
-setPath p u = u { _path = fromJust $ parsePath p }
-
-setQuery :: Query -> URI -> URI
-setQuery q u = u { _query = q }
-
-setFragment :: Fragment -> URI -> URI
-setFragment q u = u { _fragment  = q }
-
-setUserinfo :: UserInfo -> URI -> URI
-setUserinfo i u = u { _authority = (_authority u) { _userinfo = i }}
-
-setHost :: String -> URI -> URI
-setHost h u = u { _authority = (_authority u) { _host = fromJust $ parseHost h }}
-
-setPort :: Port -> URI -> URI
-setPort p u = u { _authority = (_authority u) { _port = p }}
-
--- modifier functions
-modScheme :: (Scheme -> Scheme) -> URI -> URI
-modScheme f u = setScheme (f $ scheme u) u
-
-modAuthority :: (String -> String) -> URI -> URI
-modAuthority f u = setAuthority (f $ authority u) u
-
-modPath :: (String -> String) -> URI -> URI
-modPath f u = setPath (f $ encode $ path u) u
-
-modQuery :: (Query -> Query) -> URI -> URI
-modQuery f u = setQuery (f $ query u) u
-
-modUserinfo :: (UserInfo -> UserInfo) -> URI -> URI
-modUserinfo f u = setUserinfo  (f $ userinfo u) u
-
-modHost :: (String -> String) -> URI -> URI
-modHost f u = setHost (f $ host u) u
-
-modPort :: (Port -> Port) -> URI -> URI
-modPort f u = setPort (f $ port u) u
-
 -------[ path encoding and decoding ]------------------------------------------
 
 encode :: String -> String
@@ -448,7 +404,7 @@
   ,     (pure                <$>                                digit)
   ]
 
-pRegName :: GenParser Char st Label
+pRegName :: GenParser Char st String
 pRegName = concat <$> many1 (
       (pure <$> pUnreserved)
   <|>           pPctEncoded
@@ -459,7 +415,7 @@
 pHostname :: GenParser Char st Domain
 pHostname = sepBy (option "" pDomainlabel) (string ".")
 
-pDomainlabel :: GenParser Char st Label
+pDomainlabel :: GenParser Char st String
 pDomainlabel = intercalate "-" <$> sepBy1 (some pAlphanum) (string "-")
 
 -- 3.2.3.  Port
@@ -545,52 +501,54 @@
   <$> sepBy ((,)
   <$> many (noneOf "=&")
   <*> pMaybe (char '='
-   *> many (noneOf "&")))
+   *> (translateParam <$> many (noneOf "&"))))
       (char '&')
 
 parseQueryParams :: String -> Maybe Parameters
 parseQueryParams = eitherToMaybe . parse pQueryParams  ""
 
 queryParams :: URI -> Parameters
-queryParams = maybe [] id . parseQueryParams . query
+queryParams = maybe [] id . parseQueryParams . lget query
 
--------[ filename path utilities ]---------------------------------------------
+-- Translate special characters in a parameter.
+translateParam :: String -> String
+translateParam []       = []
+translateParam ('+':xs) = ' ' : translateParam xs
+translateParam (x:xs)   = x   : translateParam xs
 
-extension :: URI -> Maybe String
-extension u = do
-  lst <- safeLast . _segments . _path $ u
-  guardMaybe (elem '.' lst)
-  return $ withReverse (takeWhile (/='.')) lst
+-------[ filename path utilities ]---------------------------------------------
 
-setExtension :: Maybe String -> URI -> URI
-setExtension e u =
-  let ex = maybe "" ('.':) e in
-  (\f -> modPath (\p -> f p ++ ex) u)
-  $ maybe id (const $ withReverse (tail . dropWhile (/='.')))
-    (extension u)
+mkPathRelative :: FilePath -> FilePath
+mkPathRelative = dropWhile (=='/')
 
-modExtension :: (String -> String) -> URI -> URI
-modExtension f u = setExtension (f `fmap` extension u) u
+-- Generate a label for the filename extension.
 
-relative :: URI -> URI
-relative = modPath (dropWhile (=='/'))
+extension :: Label FilePath (Maybe String)
+extension = Label {lget = getExt, lset = setExt}
+  where
+    splt     p = (\(a,b) -> (reverse a, reverse b)) $ break (=='.') $ reverse p
+    isExt e  p = '/' `elem` e || not ('.' `elem` p)
+    getExt   p = let (u, v) = splt p in
+                 if isExt u v then Nothing else Just u
+    setExt e p = let (u, v) = splt p in
+                 (if isExt u v then p else init v) ++ maybe "" ('.':) e
 
 -- Try to guess the 'correct' mime type for the input file based on the file
 -- extension.
 
-mimetype :: URI -> Maybe String
-mimetype u = extension u >>= mime
+mimetype :: FilePath -> Maybe String
+mimetype p = lget extension p >>= mime
 
 -- Normalize a path by removing or merging all dot or dot-dot segments and
 -- double slashes. Todo: cleanup, remove fixp.
 
 normalize :: FilePath -> FilePath
 normalize [] = []
-normalize p = fixAbs absolute $ intercalate "/" $ norm
+normalize p = fixAbs absolut $ intercalate "/" $ norm
   where
     fixAbs True          = ('/':)
     fixAbs False         = id
-    absolute             = head p == '/'
+    absolut              = head p == '/'
     norm                 = fixp False $ split '/' p
     fixp False xs        = let ys = merge xs in fixp (xs == ys) ys
     fixp True  xs        = xs
diff --git a/src/Network/Salvia/Advanced/CleverCSS.hs b/src/Network/Salvia/Advanced/CleverCSS.hs
--- a/src/Network/Salvia/Advanced/CleverCSS.hs
+++ b/src/Network/Salvia/Advanced/CleverCSS.hs
@@ -4,15 +4,14 @@
   , hParametrizedCleverCSS
   ) where
 
-import Text.CSS.CleverCSS (cleverCSSConvert)
-
+import Network.Protocol.Uri (Parameters)
 import Network.Salvia.Handlers.ExtensionDispatcher (hExtension)
+import Network.Salvia.Handlers.Fallback (hOr)
 import Network.Salvia.Handlers.File (hFile, hFileFilter)
-import Network.Salvia.Handlers.Rewrite (hRewriteExt)
 import Network.Salvia.Handlers.PathRouter (hParameters)
-import Network.Salvia.Handlers.Fallback (hOr)
-import Network.Protocol.Uri (Parameters)
+import Network.Salvia.Handlers.Rewrite (hRewriteExt)
 import Network.Salvia.Httpd (Handler)
+import Text.CSS.CleverCSS (cleverCSSConvert)
 
 hFilterCSS :: Handler () -> Handler () -> Handler ()
 hFilterCSS cssfilter handler = do
@@ -21,12 +20,10 @@
     handler
 
 hCleverCSS :: Handler ()
-hCleverCSS = do
-  params <- hParameters
-  hParametrizedCleverCSS params
+hCleverCSS = hParameters >>= hParametrizedCleverCSS
 
 hParametrizedCleverCSS :: Parameters -> Handler ()
 hParametrizedCleverCSS p = do
-  hRewriteExt ('c':) (hFileFilter convert)
+  hRewriteExt (fmap ('c':)) (hFileFilter convert)
   where convert = either id id . flip (cleverCSSConvert "") (map (fmap $ maybe "" id) p)
 
diff --git a/src/Network/Salvia/Advanced/ExtendedFileSystem.hs b/src/Network/Salvia/Advanced/ExtendedFileSystem.hs
--- a/src/Network/Salvia/Advanced/ExtendedFileSystem.hs
+++ b/src/Network/Salvia/Advanced/ExtendedFileSystem.hs
@@ -1,17 +1,20 @@
 module Network.Salvia.Advanced.ExtendedFileSystem (hExtendedFileSystem) where
 
-import Network.Salvia.Handlers.File (hFile)
-import Network.Salvia.Handlers.Directory (hDirectory)
+import Network.Salvia.Advanced.CleverCSS (hFilterCSS, hCleverCSS)
+import Network.Salvia.Advanced.HsColour (hHighlightHaskell, hHsColour)
+import Network.Salvia.Handlers.Directory (hDirectoryResource)
+import Network.Salvia.Handlers.File (hFileResource)
 import Network.Salvia.Handlers.FileSystem (hFileTypeDispatcher)
+import Network.Salvia.Handlers.Rewrite (hWithDir)
 import Network.Salvia.Httpd (Handler)
-import Network.Salvia.Advanced.HsColour (hHighlightHaskell, hHsColour)
-import Network.Salvia.Advanced.CleverCSS (hFilterCSS, hCleverCSS)
 
 hExtendedFileSystem :: FilePath -> Handler ()
 hExtendedFileSystem dir =
-  hFileTypeDispatcher dir
-    hDirectory
-    (hHighlightHaskell hHsColour
-      $ hFilterCSS hCleverCSS
-      $ hFile)
+    hFileTypeDispatcher dir
+    hDirectoryResource
+  $ \r -> hHighlightHaskell (hHsColour r)
+  $ hWithDir dir
+  $ hFilterCSS hCleverCSS
+  $ hFileResource r
+
 
diff --git a/src/Network/Salvia/Advanced/HsColour.hs b/src/Network/Salvia/Advanced/HsColour.hs
--- a/src/Network/Salvia/Advanced/HsColour.hs
+++ b/src/Network/Salvia/Advanced/HsColour.hs
@@ -6,11 +6,11 @@
   , defaultStyleSheet
   ) where
 
+import Data.Record.Label
 import Language.Haskell.HsColour.CSS
-
+import Network.Protocol.Http (contentType, utf8)
 import Network.Salvia.Handlers.ExtensionDispatcher
 import Network.Salvia.Handlers.File
-import Network.Protocol.Http (setContentType, utf8)
 import Network.Salvia.Httpd
 
 hHighlightHaskell :: Handler () -> Handler () -> Handler ()
@@ -19,20 +19,19 @@
     (Just "hs",  highlighter)
   , (Just "lhs", highlighter)
   , (Just "ag",  highlighter)
-  ] 
+  ]
 
-hHsColour :: Handler ()
+hHsColour :: ResourceHandler ()
 hHsColour = hHsColourCustomStyle (Left defaultStyleSheet)
 
 -- Left means direct inclusion of stylesheet, right means link to external
 -- stylesheet.
 
-hHsColourCustomStyle :: Either String String -> Handler ()
-hHsColourCustomStyle style = do
+hHsColourCustomStyle :: Either String String -> ResourceHandler ()
+hHsColourCustomStyle style r = do
   sendStr (either id makeStyleLink style)
-  hFileFilter (hscolour False True "")
-  modResponse
-    $ setContentType ("text/html") (Just utf8)
+  hFileResourceFilter (hscolour False True "") r
+  setM (contentType % response) ("text/html", Just utf8)
 
 makeStyleLink :: String -> String
 makeStyleLink css = "<link rel=\"stylesheet\" type=\"text/css\" href=\"" ++ css ++ "\"></link>"
diff --git a/src/Network/Salvia/Core/Handler.hs b/src/Network/Salvia/Core/Handler.hs
--- a/src/Network/Salvia/Core/Handler.hs
+++ b/src/Network/Salvia/Core/Handler.hs
@@ -1,27 +1,32 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}
 
 module Network.Salvia.Core.Handler (
     SendAction
   , SendQueue
   , Context (..)
-  , makeContext
 
+  , config
+  , request
+  , response
+  , sock
+  , address
+  , queue
+
+  , mkContext
+
   , Handler
   , ResourceHandler
   , UriHandler
-  , putRequest, putResponse, putQueue
-  , modRequest, modResponse, modQueue
-  , withRequest, withResponse
   ) where
 
 import Control.Applicative (Applicative, pure, (<*>))
-import Control.Monad.State (StateT, ap, modify, gets)
-import Network.Socket (SockAddr)
-import System.IO
-
-import Network.Salvia.Core.Config
+import Control.Monad.State (StateT, ap)
+import Data.Record.Label
 import Network.Protocol.Http (Message, emptyRequest, emptyResponse)
 import Network.Protocol.Uri (URI)
+import Network.Salvia.Core.Config
+import Network.Socket (SockAddr)
+import System.IO
 
 -------- single request/response context --------------------------------------
 
@@ -30,29 +35,32 @@
 
 data Context =
   Context {
-  -- | The HTTP server configuration.
-    config   :: HttpdConfig
-  -- | The HTTP request header.
-  , request  :: Message
-  -- | The HTTP response header.
-  , response :: Message
-  -- | The socket handle for the connection with the client.
-  , sock     :: Handle
-  -- | The client addres.
-  , address  :: SockAddr
-  -- | The queue of send actions.
-  , queue    :: SendQueue
+    _config   :: HttpdConfig -- ^ The HTTP server configuration.
+  , _request  :: Message     -- ^ The HTTP request header.
+  , _response :: Message     -- ^ The HTTP response header.
+  , _sock     :: Handle      -- ^ The socket handle for the connection with the client.
+  , _address  :: SockAddr    -- ^ The client addres.
+  , _queue    :: SendQueue   -- ^ The queue of send actions.
   }
 
+$(mkLabels [''Context])
+
+queue    :: Label Context SendQueue
+address  :: Label Context SockAddr
+sock     :: Label Context Handle
+response :: Label Context Message
+request  :: Label Context Message
+config   :: Label Context HttpdConfig
+
 -- Create and empty server context.
-makeContext :: HttpdConfig -> SockAddr -> Handle -> Context
-makeContext c a s = Context {
-    config   = c
-  , request  = emptyRequest
-  , response = emptyResponse  -- 200 OK, by default.
-  , sock     = s
-  , address  = a
-  , queue    = []
+mkContext :: HttpdConfig -> SockAddr -> Handle -> Context
+mkContext c a s = Context {
+    _config   = c
+  , _request  = emptyRequest
+  , _response = emptyResponse  -- 200 OK, by default.
+  , _sock     = s
+  , _address  = a
+  , _queue    = []
   }
 
 -------- request handlers -----------------------------------------------------
@@ -66,36 +74,4 @@
 instance Applicative (StateT Context IO) where
   pure  = return
   (<*>) = ap
-
--- Domain specific setters and modifiers.
-
-putRequest :: Message -> Handler ()
-putRequest  r = modify (\m -> m { request  = r })
-
-modRequest :: (Message -> Message) -> Handler ()
-modRequest  f = gets request  >>= putRequest  . f
-
-putResponse :: Message -> Handler ()
-putResponse r = modify (\m -> m { response = r })
-
-modResponse :: (Message -> Message) -> Handler ()
-modResponse f = gets response >>= putResponse . f
-
-putQueue :: SendQueue -> Handler ()
-putQueue    q = modify (\m -> m { queue = q })
-
-modQueue :: (SendQueue -> SendQueue) -> Handler ()
-modQueue    f = gets queue >>= putQueue . f
-
--- Execute handlers in a modified environment, but restore the original state.
--- This is comparable to the `local' function from the Reader monad.
-withModified :: (Monad m) => m d -> (t -> m a) -> (d -> m b) -> t -> m c -> m c
-withModified get m put f h =
-  do { o <- get ; m f ; r <- h ; put o ; return r }
-
-withRequest :: (Message -> Message) -> Handler a -> Handler a
-withRequest = withModified (gets request) modRequest putRequest
-
-withResponse :: (Message -> Message) -> Handler a -> Handler a
-withResponse = withModified (gets response) modResponse putResponse
 
diff --git a/src/Network/Salvia/Core/IO.hs b/src/Network/Salvia/Core/IO.hs
--- a/src/Network/Salvia/Core/IO.hs
+++ b/src/Network/Salvia/Core/IO.hs
@@ -26,26 +26,26 @@
 import Control.Monad.State
 import Data.Encoding (decodeLazy)
 import Data.Encoding.UTF8
-import System.IO
-import qualified Data.ByteString.Lazy as B
-import qualified System.IO.UTF8 as U
-
+import Data.Record.Label
 import Network.Protocol.Http
 import Network.Protocol.Uri (Parameters, parseQueryParams, decode)
 import Network.Salvia.Core.Handler
+import System.IO
+import qualified Data.ByteString.Lazy as B
+import qualified System.IO.UTF8 as U
 
 -------------------------------------------------------------------------------
 
 -- Send the response header to the socket.
 sendHeaders :: Handler ()
 sendHeaders = do
-  r <- gets response
-  s <- gets sock 
+  r <- getM response
+  s <- getM sock 
   lift $ hPutStr s (showMessageHeader r)
 
 -- Queue a potential send action in the send queue.
 send :: SendAction -> Handler ()
-send f = modify (\m -> m { queue = (queue m) ++ [f] })
+send f = modM queue (++[f]) -- modify (\m -> m { queue = (queue m) ++ [f] })
 
 -- Queue a String for sending.
 sendStr, sendStrLn :: String -> Handler ()
@@ -90,12 +90,12 @@
 
 -- Reset the send queue.
 emptyQueue :: Handler ()
-emptyQueue = putQueue []
+emptyQueue = setM queue []
 
 -- Reset both the send queue and the generated response.
 reset :: Handler ()
 reset = do
-  putResponse emptyResponse
+  setM response emptyResponse
   emptyQueue
 
 {- |
@@ -111,13 +111,12 @@
 
 contents :: Handler (Maybe B.ByteString)
 contents = do
-  r <- gets request
-  s <- gets sock
-  let len = getContentLength r
-      kpa = getKeepAlive     r
+  len <- getM (contentLength % request)
+  kpa <- getM (keepAlive     % request)
+  s   <- getM sock
   lift $
     case (kpa, len) of
-      (_,       Just n)  -> liftM Just (B.hGet s n)
+      (_,       Just n)  -> liftM Just (B.hGet s (fromIntegral n))
       (Nothing, Nothing) -> liftM Just (B.hGetContents s)
       _                  -> return Nothing
 
diff --git a/src/Network/Salvia/Core/Main.hs b/src/Network/Salvia/Core/Main.hs
--- a/src/Network/Salvia/Core/Main.hs
+++ b/src/Network/Salvia/Core/Main.hs
@@ -1,9 +1,8 @@
 module Network.Salvia.Core.Main (start) where
 
 import Control.Monad.State
-
 import Network.Salvia.Core.Config (listenAddr, listenPort, backlog, HttpdConfig)
-import Network.Salvia.Core.Handler (Handler, makeContext)
+import Network.Salvia.Core.Handler (Handler, mkContext)
 import Network.Salvia.Core.Network (server)
 
 -------- HTTP deamon implementation -------------------------------------------
@@ -23,5 +22,5 @@
   where
     tcpHandler handle addr = 
       fst `liftM` runStateT httpHandler
-        (makeContext config addr handle)
+        (mkContext config addr handle)
 
diff --git a/src/Network/Salvia/Core/Network.hs b/src/Network/Salvia/Core/Network.hs
--- a/src/Network/Salvia/Core/Network.hs
+++ b/src/Network/Salvia/Core/Network.hs
@@ -1,7 +1,6 @@
 module Network.Salvia.Core.Network where
 
 import Control.Concurrent (forkIO)
--- import Control.Exception (try)
 import Control.Monad
 import Network.Socket
 import System.IO
diff --git a/src/Network/Salvia/Handlers/Banner.hs b/src/Network/Salvia/Handlers/Banner.hs
--- a/src/Network/Salvia/Handlers/Banner.hs
+++ b/src/Network/Salvia/Handlers/Banner.hs
@@ -1,13 +1,13 @@
 module Network.Salvia.Handlers.Banner (hBanner) where
 
 import Control.Monad.State
+import Data.Record.Label
 import Data.Time.Clock (getCurrentTime)
-import Data.Time.LocalTime (getCurrentTimeZone, utcToLocalTime)
 import Data.Time.Format (formatTime)
-import System.Locale (defaultTimeLocale)
-
-import Network.Salvia.Httpd
+import Data.Time.LocalTime (getCurrentTimeZone, utcToLocalTime)
 import Network.Protocol.Http
+import Network.Salvia.Httpd
+import System.Locale (defaultTimeLocale)
 
 -- | The 'hBanner' handler adds the current date-/timestamp and a custom server
 -- name to the response headers.
@@ -15,12 +15,12 @@
 hBanner ::
      String     -- ^ The HTTP server name.
   -> Handler ()
-hBanner server = do
-  date <- lift $ do
+hBanner sv = do
+  dt <- lift $ do
     zone <- getCurrentTimeZone
     time <- liftM (utcToLocalTime zone) getCurrentTime
     return $ formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" time
-  modResponse
-    $ setDate   date
-    . setServer server
+  enterM response $ do
+    setM date   dt
+    setM server sv
 
diff --git a/src/Network/Salvia/Handlers/CGI.hs b/src/Network/Salvia/Handlers/CGI.hs
--- a/src/Network/Salvia/Handlers/CGI.hs
+++ b/src/Network/Salvia/Handlers/CGI.hs
@@ -1,17 +1,16 @@
 module Network.Salvia.Handlers.CGI (hCGI) where
 
 import Control.Monad.State
+import Data.Record.Label
+import Network.Protocol.Http
+import Network.Salvia.Httpd
 import System.IO
 import System.Process (runProcess, waitForProcess)
 
-import Network.Salvia.Httpd
-import Network.Protocol.Http
-
 hCGI :: FilePath -> Handler ()
 hCGI name = do
-  modResponse
-    $ setStatus OK
-  h <- gets sock
+  setM (status % response) OK
+  h <- getM sock
   lift $ do
     p <- runProcess name [] Nothing Nothing (Just h) (Just h) (Just stderr)
     waitForProcess p
diff --git a/src/Network/Salvia/Handlers/Cookie.hs b/src/Network/Salvia/Handlers/Cookie.hs
--- a/src/Network/Salvia/Handlers/Cookie.hs
+++ b/src/Network/Salvia/Handlers/Cookie.hs
@@ -7,26 +7,26 @@
 
 import Control.Applicative hiding (empty)
 import Control.Monad.State
+import Data.Record.Label
 import Data.Time.Format
 import Data.Time.LocalTime
-import System.Locale (defaultTimeLocale)
-
+import Network.Protocol.Cookie (showCookies, Cookie, Cookies, parseCookies, empty, path, port, expires)
+import Network.Protocol.Http (cookie)
 import Network.Salvia.Httpd
-import Network.Protocol.Cookie
-import Network.Protocol.Http (getCookie, setCookie)
+import System.Locale (defaultTimeLocale)
 
 hSetCookies :: Cookies -> Handler ()
-hSetCookies = modResponse . setCookie . showCookies
+hSetCookies = setM (cookie % response) . showCookies
 
 hGetCookies :: Handler (Maybe Cookies)
-hGetCookies = parseCookies <$> getCookie <$> gets request
+hGetCookies = parseCookies <$> getM (cookie % request)
 
 -- Convenient method for creating cookies that expire in the near future and
 -- are bound to the domain and port this server runs on. The path will be
 -- locked to root.
 newCookie :: LocalTime -> Handler Cookie
 newCookie expire = do
-  httpd <- gets config
+  httpd <- getM config
   return $ empty {
       path    = Just "/"
 --  , domain  = Just $ '.' : hostname httpd
diff --git a/src/Network/Salvia/Handlers/Counter.hs b/src/Network/Salvia/Handlers/Counter.hs
--- a/src/Network/Salvia/Handlers/Counter.hs
+++ b/src/Network/Salvia/Handlers/Counter.hs
@@ -1,8 +1,7 @@
 module Network.Salvia.Handlers.Counter (hCounter) where
 
-import Control.Monad.State
 import Control.Concurrent.STM
-
+import Control.Monad.State
 import Network.Salvia.Httpd
 
 hCounter :: TVar Int -> Handler ()
diff --git a/src/Network/Salvia/Handlers/Default.hs b/src/Network/Salvia/Handlers/Default.hs
--- a/src/Network/Salvia/Handlers/Default.hs
+++ b/src/Network/Salvia/Handlers/Default.hs
@@ -1,8 +1,7 @@
 module Network.Salvia.Handlers.Default (hDefault) where
 
-import System.IO
 import Control.Concurrent.STM
-
+import Network.Protocol.Http
 import Network.Salvia.Handlers.Banner
 import Network.Salvia.Handlers.Counter
 import Network.Salvia.Handlers.Error
@@ -12,15 +11,14 @@
 import Network.Salvia.Handlers.Printer
 import Network.Salvia.Handlers.Session
 import Network.Salvia.Httpd
-import Network.Protocol.Http
+import System.IO
 
-hDefault :: TVar Int -> Sessions a -> SessionHandler a () -> Handler ()
+hDefault :: Show a => TVar Int -> Sessions a -> SessionHandler a () -> Handler ()
 hDefault count sessions handler = do
   hBanner "salvia-httpd"
-  hParser onerror
-    $ hHead $ do
-      session <- hSession sessions 300
-      handler session
+  hParser onerror $ do
+    session <- hSession sessions 300
+    hHead $ handler session
   hPrinter
   hLog count stdout
   hCounter count
diff --git a/src/Network/Salvia/Handlers/Directory.hs b/src/Network/Salvia/Handlers/Directory.hs
--- a/src/Network/Salvia/Handlers/Directory.hs
+++ b/src/Network/Salvia/Handlers/Directory.hs
@@ -5,35 +5,35 @@
 
 import Control.Monad.State
 import Data.List (sort)
-import System.Directory (doesDirectoryExist, getDirectoryContents)
-
-import Network.Salvia.Httpd
-import Network.Salvia.Handlers.Redirect
-import Network.Salvia.Handlers.File (hResource)
-import Network.Protocol.Http
-import Network.Protocol.Uri (path, modPath)
+import Data.Record.Label
 import Misc.Misc (bool)
+import Network.Protocol.Http
+import Network.Protocol.Uri (path)
+import Network.Salvia.Handlers.File (hResource)
+import Network.Salvia.Handlers.Redirect
+import Network.Salvia.Httpd
+import System.Directory (doesDirectoryExist, getDirectoryContents)
 
 hDirectory :: Handler ()
 hDirectory = hResource hDirectoryResource
 
 hDirectoryResource :: ResourceHandler ()
 hDirectoryResource dirName = do
-  req <- gets request
-  if (null $ path $ uri req) || (last $ path $ uri req) /= '/'
-   then hRedirect (modPath (++"/") $ uri req)
+  (u, p) <- bothM (uri % request) (getM path)
+  if (null p) || last p /= '/'
+   then hRedirect (lmod path (++"/") u)
    else dirHandler dirName
 
 dirHandler:: ResourceHandler ()
 dirHandler dirName = do
-  req <- gets request
+  p <- getM (path % uri % request)
   filenames <- lift $ getDirectoryContents dirName
   processed <- lift $ mapM (processFilename dirName) (sort filenames)
-  let b = listing (path $ uri req) processed
-  modResponse
-    $ setContentType   "text/html" Nothing
-    . setContentLength (length b)
-    . setStatus OK
+  let b = listing p processed
+  enterM response $ do
+    setM contentType ("text/html", Nothing)
+    setM contentLength (Just $ fromIntegral $ length b)
+    setM status OK
   sendStr b
 
 -- Add trailing slash to a directory name.
diff --git a/src/Network/Salvia/Handlers/Dispatching.hs b/src/Network/Salvia/Handlers/Dispatching.hs
--- a/src/Network/Salvia/Handlers/Dispatching.hs
+++ b/src/Network/Salvia/Handlers/Dispatching.hs
@@ -5,16 +5,15 @@
   , hListDispatch
   ) where
 
-import Control.Monad.State
-
+import Data.Record.Label
 import Network.Salvia.Httpd
 
 type Dispatcher     a b = a -> Handler b   -> Handler b -> Handler b
 type ListDispatcher a b = [(a, Handler b)] -> Handler b -> Handler b
 
-hDispatch :: (Show c, Show a) => (Context -> c) -> (a -> c -> Bool) -> Dispatcher a b
+hDispatch :: (Show a, Show c) => Label Context c -> (a -> c -> Bool) -> Dispatcher a b
 hDispatch f match a handler _default = do
-  ctx <- gets f
+  ctx <- getM f
   if a `match` ctx
     then handler
     else _default
diff --git a/src/Network/Salvia/Handlers/Error.hs b/src/Network/Salvia/Handlers/Error.hs
--- a/src/Network/Salvia/Handlers/Error.hs
+++ b/src/Network/Salvia/Handlers/Error.hs
@@ -5,11 +5,11 @@
   , safeIO
   ) where
 
-import System.IO.Error
-
 import Control.Monad.State
-import Network.Salvia.Httpd
+import Data.Record.Label
 import Network.Protocol.Http
+import Network.Salvia.Httpd
+import System.IO.Error
 
 {- |
 The 'hError' handler enables the creation of a default style of error responses
@@ -27,9 +27,9 @@
   -> String     -- ^ Custom error message.
   -> Handler ()
 hCustomError e m = do
-  modResponse
-    $ setStatus e
-    . setContentType "text/plain" Nothing
+  enterM response $ do
+    setM status e
+    setM contentType ("text/plain", Nothing)
   sendStr m
 
 -- | Map IO errors to a default style error response.
diff --git a/src/Network/Salvia/Handlers/ExtensionDispatcher.hs b/src/Network/Salvia/Handlers/ExtensionDispatcher.hs
--- a/src/Network/Salvia/Handlers/ExtensionDispatcher.hs
+++ b/src/Network/Salvia/Handlers/ExtensionDispatcher.hs
@@ -3,13 +3,14 @@
   , hExtensionRouter
   ) where
 
-import Network.Salvia.Httpd (request)
+import Data.Record.Label
 import Network.Protocol.Http (uri)
-import Network.Protocol.Uri (extension)
+import Network.Protocol.Uri (extension, path)
 import Network.Salvia.Handlers.Dispatching
+import Network.Salvia.Httpd (request)
 
 hExtension :: Dispatcher (Maybe String) a
-hExtension = hDispatch (extension . uri . request) (==)
+hExtension = hDispatch (extension % path % uri % request) (==)
 
 hExtensionRouter :: ListDispatcher (Maybe String) a
 hExtensionRouter = hListDispatch hExtension
diff --git a/src/Network/Salvia/Handlers/Fallback.hs b/src/Network/Salvia/Handlers/Fallback.hs
--- a/src/Network/Salvia/Handlers/Fallback.hs
+++ b/src/Network/Salvia/Handlers/Fallback.hs
@@ -2,8 +2,9 @@
 
 import Control.Applicative
 import Control.Monad.State
-import Network.Salvia.Httpd
+import Data.Record.Label
 import Network.Protocol.Http
+import Network.Salvia.Httpd
 
 {- |
 Until I figure out how to do this correctly, this handler somewow implements
@@ -14,7 +15,7 @@
 hOr :: Handler a -> Handler a -> Handler a
 hOr h0 h1 = do
   a  <- h0
-  st <- gets (status . response)
+  st <- getM (status % response)
   if statusFailure st
     then reset >> h1
     else return a
diff --git a/src/Network/Salvia/Handlers/File.hs b/src/Network/Salvia/Handlers/File.hs
--- a/src/Network/Salvia/Handlers/File.hs
+++ b/src/Network/Salvia/Handlers/File.hs
@@ -10,13 +10,13 @@
   ) where
 
 import Control.Monad.State
-import System.IO
-
-import Network.Salvia.Httpd
-import Network.Salvia.Handlers.Error
+import Data.Record.Label
 import Network.Protocol.Http
-import Network.Protocol.Uri (mimetype, path, parseURI)
 import Network.Protocol.Mime
+import Network.Protocol.Uri (mimetype, path, parseURI)
+import Network.Salvia.Handlers.Error
+import Network.Salvia.Httpd
+import System.IO
 
 hFile :: Handler ()
 hFile = hResource hFileResource
@@ -30,7 +30,7 @@
 -}
 
 hResource :: ResourceHandler a -> Handler a
-hResource rh = gets request >>= rh . path . uri
+hResource rh = getM (path % uri % request) >>= rh
 
 {-
 Turn a URI handler into a regular handler that utilizes the request URI as the
@@ -38,7 +38,7 @@
 -}
 
 hUri :: UriHandler a -> Handler a
-hUri rh = gets request >>= rh . uri
+hUri rh = getM (uri % request) >>= rh
 
 -------- HTTP deamon implementation -------------------------------------------
 
@@ -46,24 +46,24 @@
 -- TODO: what to do with encoding?
 hFileResource :: ResourceHandler ()
 hFileResource file = do
-  let m = maybe defaultMime id $ (parseURI file >>= mimetype)
+  let m = maybe defaultMime id $ (parseURI file >>= mimetype . lget path)
   safeIO (openBinaryFile file ReadMode)
     $ \fd -> do
       fs <- lift $ hFileSize fd
-      modResponse
-        $ setContentType m (Just "utf-8")
-        . setContentLength fs
-        . setStatus OK
+      enterM response $ do
+        setM contentType (m, Just "utf-8")
+        setM contentLength (Just fs)
+        setM status OK
       spoolBs id fd
 
 -- TODO: what to do with encoding?
 hFileResourceFilter :: (String -> String) -> ResourceHandler ()
 hFileResourceFilter fFilter file = do  -- TODO... this should be a more general hFilter
-  let m = maybe defaultMime id $ (parseURI file >>= mimetype)
+  let m = maybe defaultMime id $ (parseURI file >>= mimetype . lget path)
   safeIO (openBinaryFile file ReadMode)
     $ \fd -> do
-      modResponse
-        $ setContentType m (Just "utf-8")
-        . setStatus OK
+      enterM response $ do
+        setM contentType (m, Just "utf-8")
+        setM status OK
       spool fFilter fd
 
diff --git a/src/Network/Salvia/Handlers/FileSystem.hs b/src/Network/Salvia/Handlers/FileSystem.hs
--- a/src/Network/Salvia/Handlers/FileSystem.hs
+++ b/src/Network/Salvia/Handlers/FileSystem.hs
@@ -5,37 +5,34 @@
   ) where
 
 import Control.Monad.State
-import System.Directory (doesDirectoryExist)
-
-import Network.Salvia.Httpd
+import Data.Record.Label
+import Misc.Misc (bool)
+import Network.Protocol.Http
+import Network.Protocol.Uri (jail, path)
+import Network.Salvia.Handlers.Directory
 import Network.Salvia.Handlers.Error
 import Network.Salvia.Handlers.File
-import Network.Salvia.Handlers.Directory
-import Network.Salvia.Handlers.Rewrite
-import Network.Protocol.Http
-import Network.Protocol.Uri (jail)
-import Misc.Misc (bool)
+import Network.Salvia.Httpd
+import System.Directory (doesDirectoryExist)
 
 -- Show file contents and show directory indexes.
 hFileSystem :: ResourceHandler ()
-hFileSystem dir = hFileTypeDispatcher dir hDirectory hFile
+hFileSystem dir = hFileTypeDispatcher dir hDirectoryResource hFileResource
 
 -- Show file contents, do not show directory indexes.
 hFileSystemNoIndexes :: ResourceHandler ()
-hFileSystemNoIndexes dir = hFileTypeDispatcher dir (hError Forbidden) hFile
+hFileSystemNoIndexes dir = hFileTypeDispatcher dir (const $ hError Forbidden) hFileResource
 
 -- Dispatch based on file type, regular files or directories.
-hFileTypeDispatcher :: FilePath -> Handler () -> Handler () -> Handler () 
+hFileTypeDispatcher :: FilePath -> ResourceHandler () -> ResourceHandler () -> Handler () 
 hFileTypeDispatcher dir hdir hfile =
-  hWithDir dir
-    $ hResource
-    $ hJailedDispatch dir hdir hfile
+  getM (path % uri % request) >>=
+  hJailedDispatch dir hdir hfile . (dir ++)
 
-hJailedDispatch :: FilePath -> Handler () -> Handler () -> ResourceHandler () 
+hJailedDispatch :: FilePath -> ResourceHandler () -> ResourceHandler () -> ResourceHandler () 
 hJailedDispatch dir hdir hfile file = do
   case jail dir file of
     Nothing -> hError Forbidden
-    Just f  -> do
-      isDir <- lift (doesDirectoryExist f)
-      bool hdir hfile isDir
+    Just f  -> bool (hdir file) (hfile file)
+           =<< lift (doesDirectoryExist f) 
 
diff --git a/src/Network/Salvia/Handlers/Head.hs b/src/Network/Salvia/Handlers/Head.hs
--- a/src/Network/Salvia/Handlers/Head.hs
+++ b/src/Network/Salvia/Handlers/Head.hs
@@ -1,10 +1,10 @@
 module Network.Salvia.Handlers.Head (hHead) where
 
 import Control.Applicative
-import Control.Monad.State
-
-import Network.Salvia.Httpd
+import Control.Monad.State (put)
+import Data.Record.Label
 import Network.Protocol.Http
+import Network.Salvia.Httpd
 
 {- |
 The 'hHead' handler makes sure no response body is sent to the client when the
@@ -15,9 +15,9 @@
 
 hHead :: Handler a -> Handler a
 hHead handler = do
-  m <- gets (method . request)
+  m <- getM (method % request)
   case m of
-    HEAD -> withRequest (setMethod GET) handler
-         <* emptyQueue
+    HEAD -> withM (method % request) (put GET) $
+              handler <* emptyQueue
     _    -> handler
 
diff --git a/src/Network/Salvia/Handlers/Log.hs b/src/Network/Salvia/Handlers/Log.hs
--- a/src/Network/Salvia/Handlers/Log.hs
+++ b/src/Network/Salvia/Handlers/Log.hs
@@ -2,26 +2,26 @@
 
 import Control.Concurrent.STM
 import Control.Monad.State
-import System.IO
-
-import Network.Salvia.Httpd  (Handler, request, response, address)
-import Network.Protocol.Http
+import Data.Record.Label
 import Misc.Terminal (red, green, reset)
+import Network.Protocol.Http
+import Network.Salvia.Httpd  (Handler, request, response, address)
+import System.IO
 
 -- TODO: handle should be tvar as well
 hLog :: TVar Int -> Handle -> Handler Handle
 hLog count handle = do
   c    <- lift $ atomically $ readTVar count
-  req  <- gets request
-  res  <- gets response
-  addr <- gets address
-  let st   = status res
-      code = codeFromStatus st
+  mt   <- getM (method % request)
+  ur   <- getM (uri    % request)
+  st   <- getM (status % response)
+  addr <- getM address
+  let code = codeFromStatus st
       clr  = if code >= 400 then red else green
   lift $ hPutStrLn handle $ concat [
       concat ["[", show addr, "] ", show c, "\t"]
-    , show $ method req, "\t"
-    , show $ uri req , " -> "
+    , show mt, "\t"
+    , show ur, " -> "
     , clr
     , show code, " "
     , show st
diff --git a/src/Network/Salvia/Handlers/Login.hs b/src/Network/Salvia/Handlers/Login.hs
--- a/src/Network/Salvia/Handlers/Login.hs
+++ b/src/Network/Salvia/Handlers/Login.hs
@@ -21,24 +21,28 @@
   , hLogin
   , hLogout
   , hLoginfo
+
   , hAuthorized
+  , hAuthorizedUser
 
   -- * Helper functions.
   , readUserDatabase
 
   ) where
 
-import Data.List (intercalate)
-import Data.Maybe (catMaybes)
 import Control.Concurrent.STM (TVar, atomically, readTVar, writeTVar, newTVar)
 import Control.Monad.State (lift, liftM)
-
+import Data.Digest.OpenSSL.MD5 (md5sum)
+import Data.List (intercalate)
+import Data.Maybe (catMaybes)
+import Data.Record.Label
+import Misc.Misc (atomModTVar, safeHead)
+import Network.Protocol.Http (Status (Unauthorized, OK), status)
 import Network.Salvia.Handlers.Error (hCustomError, hError)
 import Network.Salvia.Handlers.Session
-import Network.Salvia.Httpd hiding (start)
-import Network.Protocol.Http (Status (Unauthorized, OK), setStatus)
-import Misc.Misc (atomModTVar, safeHead)
-import qualified Network.Protocol.Uri as URI
+import Network.Salvia.Httpd (sendStrLn, Handler, uriEncodedPostParamsUTF8, response)
+import Network.Protocol.Uri
+import Data.ByteString.UTF8 (fromString)
 
 -------------------------------------------------------------------------------
 
@@ -55,6 +59,7 @@
 data User = User {
     username :: Username
   , password :: Password
+  , email    :: String
   , actions  :: Actions
   } deriving (Eq, Show)
 
@@ -72,7 +77,7 @@
     dbUsers  :: Users
   , dbGuest  :: Actions
   , dbSource :: src
-  }
+  } deriving Show
 
 type TUserDatabase src = TVar (UserDatabase src)
 
@@ -113,11 +118,15 @@
   where
     parseUserLine line =
       case words line of
-        user:pass:acts -> Just (User user pass acts)
-        _              -> Nothing
+        user:pass:mail:acts -> Just (User user pass mail acts)
+        _                   -> Nothing
 
 printUserLine :: User -> String
-printUserLine u = intercalate " " ([username u, password u] ++ actions u)
+printUserLine u = intercalate " " ([
+    username u
+  , password u
+  , email u
+  ] ++ actions u)
 
 {- |
 The signup handler is used to create a new entry in the user database. It reads
@@ -131,7 +140,7 @@
 hSignup tdb acts = do
   db <- lift . atomically $ readTVar tdb
   params <- uriEncodedPostParamsUTF8
-  case freshUserPass params (dbUsers db) acts of
+  case freshUserInfo params (dbUsers db) acts of
     Nothing -> hCustomError Unauthorized "signup failed"
     Just u  -> do
       lift $ do
@@ -140,13 +149,14 @@
           $ UserDatabase (u : dbUsers db) (dbGuest db) (dbSource db)
         appendFile (dbSource db) (printUserLine u)
 
-freshUserPass :: Maybe URI.Parameters -> Users -> Actions -> Maybe User
-freshUserPass params us acts = do
+freshUserInfo :: Maybe Parameters -> Users -> Actions -> Maybe User
+freshUserInfo params us acts = do
   p <- params
   user <- "username" `lookup` p >>= id
   pass <- "password" `lookup` p >>= id
+  mail <- "email"    `lookup` p >>= id
   case safeHead $ filter ((==user).username) us of
-    Nothing -> return $ User user pass acts
+    Nothing -> return $ User user (md5sum $ fromString pass) mail acts
     Just _  -> Nothing
 
 -------------------------------------------------------------------------------
@@ -166,7 +176,7 @@
     (loginSuccessful session)
     (authenticate params db)
 
-authenticate :: Maybe URI.Parameters -> UserDatabase a -> Maybe User
+authenticate :: Maybe Parameters -> UserDatabase a -> Maybe User
 authenticate params db = do
   p <- params
   user <- "username" `lookup` p >>= id
@@ -174,7 +184,7 @@
   case safeHead $ filter ((==user).username) (dbUsers db) of
     Nothing -> Nothing
     Just u  ->
-      if password u == pass
+      if password u == md5sum (fromString pass)
       then return u
       else Nothing
 
@@ -182,7 +192,7 @@
 loginSuccessful :: TUserSession a -> User -> Handler ()
 loginSuccessful session user = do
   lift $ atomModTVar (\s -> s {payload = Just (UserPayload user True Nothing)}) session
-  modResponse $ setStatus OK
+  setM (status % response) OK
   sendStrLn "login successful"
 
 -------------------------------------------------------------------------------
@@ -201,9 +211,9 @@
 that is included.
 -}
 
-hLoginfo :: Show a => UserSessionHandler a ()
-hLoginfo s = do
-  s' <- lift $ atomically $ readTVar s
+hLoginfo :: UserSessionHandler a ()
+hLoginfo session = do
+  s' <- lift $ atomically $ readTVar session
 
   sendStrLn $ "sID="     ++ show (sID     s')
   sendStrLn $ "start="   ++ show (start   s')
@@ -211,8 +221,9 @@
 
   case payload s' of
     Nothing -> return ()
-    Just (UserPayload (User uname _ acts) _ _) -> do
+    Just (UserPayload (User uname _ mail acts) _ _) -> do
       sendStrLn $ "username=" ++ uname
+      sendStrLn $ "email="    ++ mail
       sendStrLn $ "actions="  ++ intercalate " " acts
 
 -------------------------------------------------------------------------------
@@ -238,5 +249,24 @@
       | action `elem` actions user -> handler (Just user)
     Nothing
       | action `elem` dbGuest db   -> handler Nothing
+    _                              -> hError Unauthorized
+
+{- |
+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. Otherwise an `Unauthorized' error will be produced. The
+guest user will not be used in any case.
+-}
+
+hAuthorizedUser ::
+     Action                      -- ^ The actions that should be authorized.
+  -> (User -> Handler ())        -- ^ The handler to perform when authorized.
+  -> UserSessionHandler a ()     -- ^ This handler requires a user session.
+
+hAuthorizedUser action handler session = do
+  load <- liftM payload (lift $ atomically $ readTVar session)
+  case load of
+    Just (UserPayload user _ _)
+      | action `elem` actions user -> handler user
     _                              -> hError Unauthorized
 
diff --git a/src/Network/Salvia/Handlers/MethodRouter.hs b/src/Network/Salvia/Handlers/MethodRouter.hs
--- a/src/Network/Salvia/Handlers/MethodRouter.hs
+++ b/src/Network/Salvia/Handlers/MethodRouter.hs
@@ -12,13 +12,14 @@
   , hCONNECT
   ) where
 
+import Data.Record.Label
+import Network.Protocol.Http
 import Network.Salvia.Handlers.Dispatching
 import Network.Salvia.Handlers.Error
 import Network.Salvia.Httpd
-import Network.Protocol.Http
 
 hMethod' :: Dispatcher Method a
-hMethod' = hDispatch (method . request) (==)
+hMethod' = hDispatch (method % request) (==)
 
 hMethodRouter :: ListDispatcher Method a
 hMethodRouter = hListDispatch hMethod'
diff --git a/src/Network/Salvia/Handlers/Parser.hs b/src/Network/Salvia/Handlers/Parser.hs
--- a/src/Network/Salvia/Handlers/Parser.hs
+++ b/src/Network/Salvia/Handlers/Parser.hs
@@ -1,11 +1,11 @@
 module Network.Salvia.Handlers.Parser (hParser) where
 
-import System.IO
 import Control.Monad.State
-import Text.ParserCombinators.Parsec (parse)
-
-import Network.Salvia.Httpd
+import Data.Record.Label
 import Network.Protocol.Http
+import Network.Salvia.Httpd
+import System.IO
+import Text.ParserCombinators.Parsec (parse)
 
 {- |
 The 'hParser' handler is used to parse the raw request message into the
@@ -21,13 +21,13 @@
   -> Handler a
 
 hParser onfail onsuccess = do
-  h <- gets sock
+  h <- getM sock
   -- TODO use try and fail with bad request or reject silently.
   msg <- lift $ readHeader h `catch` error "AAAAp"
   case parse pRequest "" (msg "") of
     Left err -> onfail (show err)
     Right x -> do
-      putRequest x
+      setM request x
       onsuccess
 
 -- Read all lines until the first empty line.
diff --git a/src/Network/Salvia/Handlers/PathRouter.hs b/src/Network/Salvia/Handlers/PathRouter.hs
--- a/src/Network/Salvia/Handlers/PathRouter.hs
+++ b/src/Network/Salvia/Handlers/PathRouter.hs
@@ -9,23 +9,23 @@
 
 import Control.Monad.State
 import Data.List (isPrefixOf)
-
-import Network.Salvia.Httpd
+import Data.Record.Label
 import Network.Protocol.Http
-import Network.Protocol.Uri (modPath, path, queryParams, Parameters)
+import Network.Protocol.Uri (path, queryParams, Parameters)
 import Network.Salvia.Handlers.Dispatching
+import Network.Salvia.Httpd
 
 chop :: String -> Handler a -> Handler a
-chop a = withRequest $ modUri $ modPath $ drop $ length a
+chop a = withM (path % uri % request) (modify (drop $ length a))
 
 hPath :: Dispatcher String a
-hPath p h d = hDispatch (path . uri . request) (==) p (chop p h) d
+hPath p h = hDispatch (path % uri % request) (==) p (chop p h)
 
 hPathRouter :: ListDispatcher String b
 hPathRouter = hListDispatch hPath
 
 hPrefix :: Dispatcher String a
-hPrefix p h d = hDispatch (path . uri . request) isPrefixOf p (chop p h) d
+hPrefix p h = hDispatch (path % uri % request) isPrefixOf p (chop p h)
 
 hPrefixRouter :: ListDispatcher String b
 hPrefixRouter = hListDispatch hPrefix
@@ -33,5 +33,5 @@
 -- Path related utilities.
 
 hParameters :: Handler Parameters
-hParameters = gets (queryParams . uri . request)
+hParameters = getM (uri % request) >>= return . queryParams 
 
diff --git a/src/Network/Salvia/Handlers/Printer.hs b/src/Network/Salvia/Handlers/Printer.hs
--- a/src/Network/Salvia/Handlers/Printer.hs
+++ b/src/Network/Salvia/Handlers/Printer.hs
@@ -1,7 +1,7 @@
 module Network.Salvia.Handlers.Printer (hPrinter) where
 
 import Control.Monad.State
-
+import Data.Record.Label (getM)
 import Network.Salvia.Httpd
 
 {- |
@@ -17,7 +17,7 @@
   sendHeaders
 
   -- Process all send actions in queue.
-  s <- gets sock
-  q <- gets queue
+  s <- getM sock
+  q <- getM queue
   lift $ mapM_ ($ s) q
 
diff --git a/src/Network/Salvia/Handlers/Put.hs b/src/Network/Salvia/Handlers/Put.hs
--- a/src/Network/Salvia/Handlers/Put.hs
+++ b/src/Network/Salvia/Handlers/Put.hs
@@ -1,12 +1,11 @@
 module Network.Salvia.Handlers.Put (hPut) where
 
 import Control.Monad.State
+import Network.Protocol.Http
+import Network.Salvia.Handlers.Error
+import Network.Salvia.Httpd
 import System.IO
 import qualified Data.ByteString.Lazy as B
-
-import Network.Salvia.Httpd
-import Network.Salvia.Handlers.Error
-import Network.Protocol.Http
 
 {- |
 First naive handler for the PUT request. This probably does not handle all the
diff --git a/src/Network/Salvia/Handlers/Redirect.hs b/src/Network/Salvia/Handlers/Redirect.hs
--- a/src/Network/Salvia/Handlers/Redirect.hs
+++ b/src/Network/Salvia/Handlers/Redirect.hs
@@ -1,12 +1,13 @@
 module Network.Salvia.Handlers.Redirect (hRedirect) where
 
-import Network.Salvia.Httpd
+import Data.Record.Label
 import Network.Protocol.Http
 import Network.Protocol.Uri (URI)
+import Network.Salvia.Httpd
 
 hRedirect :: URI -> Handler ()
-hRedirect u = do
-  modResponse
-    $ setLocation u
-    . setStatus MovedPermanently
+hRedirect u =
+  enterM response $ do
+    setM location (Just u)
+    setM status MovedPermanently
 
diff --git a/src/Network/Salvia/Handlers/Rewrite.hs b/src/Network/Salvia/Handlers/Rewrite.hs
--- a/src/Network/Salvia/Handlers/Rewrite.hs
+++ b/src/Network/Salvia/Handlers/Rewrite.hs
@@ -7,32 +7,32 @@
   , hWithoutDir
   ) where
 
-import Data.List (isPrefixOf)
 import Control.Monad.State
-
-import Network.Salvia.Httpd
+import Data.List (isPrefixOf)
+import Data.Record.Label
 import Network.Protocol.Http
-import Network.Protocol.Uri (URI, modPath, modHost, path, modExtension)
+import Network.Protocol.Uri (URI, host, path, extension)
+import Network.Salvia.Httpd
 
 hRewrite :: (URI -> URI) -> Handler a -> Handler a
-hRewrite f h = withRequest (modUri f) h
+hRewrite f = withM (uri % request) (modify f)
 
+-- express these below in terms of the above?
+
 hRewriteHost :: (String -> String) -> Handler a -> Handler a
-hRewriteHost f h = withRequest (modUri $ modHost f) h
+hRewriteHost f = withM (host % uri % request) (modify f)
 
 hRewritePath :: (String -> String) -> Handler a -> Handler a
-hRewritePath f h = withRequest (modUri $ modPath f) h
+hRewritePath f = withM (path % uri % request) (modify f)
 
-hRewriteExt :: (String -> String) -> Handler a -> Handler a
-hRewriteExt f = hRewrite (modExtension f)
+hRewriteExt :: (Maybe String -> Maybe String) -> Handler a -> Handler a
+hRewriteExt f = withM (extension % path % uri % request) (modify f)
 
 hWithDir :: String -> Handler a -> Handler a
 hWithDir d = hRewritePath (d++)
 
 hWithoutDir :: String -> Handler a -> Handler a
 hWithoutDir d h = do
-  req <- gets request
-  if (d `isPrefixOf` (path $ uri $ req))
-    then hRewritePath (drop (length d)) h
-    else h
+  p <- getM (path % uri % request)
+  (if d `isPrefixOf` p then hRewritePath (drop $ length d) else id) h
 
diff --git a/src/Network/Salvia/Handlers/Session.hs b/src/Network/Salvia/Handlers/Session.hs
--- a/src/Network/Salvia/Handlers/Session.hs
+++ b/src/Network/Salvia/Handlers/Session.hs
@@ -14,15 +14,14 @@
 import Control.Concurrent.STM
 import Control.Monad.State
 import Data.Time.LocalTime
+import Misc.Misc (safeRead, atomModTVar, atomReadTVar, now, later)
+import Network.Protocol.Cookie hiding (empty)
+import Network.Salvia.Handlers.Cookie
+import Network.Salvia.Httpd hiding (start)
 import Prelude hiding (lookup)
 import System.Random
 import qualified Data.Map as M
 
-import Network.Salvia.Handlers.Cookie
-import Network.Salvia.Httpd hiding (start)
-import Network.Protocol.Cookie hiding (empty)
-import Misc.Misc (safeRead, atomModTVar, atomReadTVar, now, later)
-
 -------------------------------------------------------------------------------
 
 -- A session identifier. Should be unique for every session.
@@ -35,7 +34,7 @@
   , start   :: LocalTime
   , expire  :: LocalTime
   , payload :: Maybe a
-  }
+  } deriving Show
 
 -- A shared session.
 type TSession a = TVar (Session a)
diff --git a/src/Network/Salvia/Handlers/VirtualHosting.hs b/src/Network/Salvia/Handlers/VirtualHosting.hs
--- a/src/Network/Salvia/Handlers/VirtualHosting.hs
+++ b/src/Network/Salvia/Handlers/VirtualHosting.hs
@@ -1,15 +1,15 @@
 module Network.Salvia.Handlers.VirtualHosting (hVirtualHosting) where
 
 import Data.List (isPrefixOf)
-
-import Network.Salvia.Httpd
-import Network.Protocol.Http
-import Network.Salvia.Handlers.Dispatching
+import Data.Record.Label
+import Network.Protocol.Http (hostname)
+import Network.Salvia.Handlers.Dispatching (Dispatcher, ListDispatcher, hListDispatch, hDispatch)
+import Network.Salvia.Httpd (request)
 
 -- isSuffixOf?
 
 hVirtualHosting1 :: Dispatcher String a
-hVirtualHosting1 = hDispatch (getHost . request) isPrefixOf
+hVirtualHosting1 = hDispatch (hostname % request) isPrefixOf
 
 hVirtualHosting :: ListDispatcher String a
 hVirtualHosting = hListDispatch hVirtualHosting1
diff --git a/src/Network/Salvia/Httpd.hs b/src/Network/Salvia/Httpd.hs
--- a/src/Network/Salvia/Httpd.hs
+++ b/src/Network/Salvia/Httpd.hs
@@ -6,14 +6,18 @@
 
   -- Httpd.Core.Handler
   , Context (..)
-  , makeContext
+  , config
+  , request
+  , response
+  , sock
+  , address
+  , queue
 
+  , mkContext
+
   , Handler
   , ResourceHandler
   , UriHandler
-  , putRequest, putResponse, putQueue
-  , modRequest, modResponse, modQueue
-  , withRequest, withResponse
 
   -- Httpd.Core.IO
   , sendHeaders