diff --git a/happstack-server.cabal b/happstack-server.cabal
--- a/happstack-server.cabal
+++ b/happstack-server.cabal
@@ -1,5 +1,5 @@
 Name:                happstack-server
-Version:             0.3.3
+Version:             0.4.1
 Synopsis:            Web related tools and services.
 Description:         Web framework
 License:             BSD3
@@ -14,7 +14,7 @@
 source-repository head
     type:     darcs
     subdir:   happstack-server
-    location: http://patch-tag.com/publicrepos/happstack
+    location: http://patch-tag.com/r/mae/happstack/pullrepo
 
 Flag base4
     Description: Choose the even newer, even smaller, split-up base package.
@@ -43,7 +43,6 @@
     Exposed-modules:   
                        Happstack.Server.Tests
   Other-modules:       
-                       Happstack.Server.S3
                        Happstack.Server.HTTPClient.HTTP
                        Happstack.Server.HTTPClient.Stream
                        Happstack.Server.HTTPClient.TCP
@@ -63,10 +62,11 @@
                        containers,
                        directory,
                        extensible-exceptions,
+                       filepath,
                        HaXml >= 1.13 && < 1.14,
                        hslogger >= 1.0.2,
-                       happstack-data >= 0.3.2 && < 0.4,
-                       happstack-util >= 0.3.2 && < 0.4,
+                       happstack-data >= 0.4.1 && < 0.5,
+                       happstack-util >= 0.4.1 && < 0.5,
                        html,
                        MaybeT,
                        mtl,
@@ -75,6 +75,7 @@
                        old-time,
                        parsec < 3,
                        process,
+                       sendfile >= 0.6.1 && < 0.7,
                        template-haskell,
                        time,
                        utf8-string >= 0.3.4 && < 0.4,
diff --git a/src/Happstack/Server/Cookie.hs b/src/Happstack/Server/Cookie.hs
--- a/src/Happstack/Server/Cookie.hs
+++ b/src/Happstack/Server/Cookie.hs
@@ -28,11 +28,12 @@
     , cookieDomain  :: String
     , cookieName    :: String
     , cookieValue   :: String
+    , secure        :: Bool
     } deriving(Show,Eq,Read,Typeable,Data)
 
 -- | Creates a cookie with a default version of 1 and path of "/"
 mkCookie :: String -> String -> Cookie
-mkCookie key val = Cookie "1" "/" "" key val
+mkCookie key val = Cookie "1" "/" "" key val False
 
 -- | Set a Cookie in the Result.
 -- The values are escaped as per RFC 2109, but some browsers may
@@ -47,7 +48,7 @@
         s f   = '\"' : concatMap e (f cookie) ++ "\""
         e c | fctl c || c == '"' = ['\\',c]
             | otherwise          = [c]
-    in concat $ intersperse ";" ((cookieName cookie++"="++s cookieValue):[ (k++v) | (k,v) <- l, "" /= v ])
+    in concat $ intersperse ";" ((cookieName cookie++"="++s cookieValue):[ (k++v) | (k,v) <- l, "" /= v ] ++ if secure cookie then ["Secure"] else [])
 
 fctl :: Char -> Bool
 fctl ch = ch == chr 127 || ch <= chr 31
@@ -74,7 +75,7 @@
             val<-value
             path<-option "" $ try (cookieSep >> cookie_path)
             domain<-option "" $ try (cookieSep >> cookie_domain)
-            return $ Cookie ver path domain (low name) val
+            return $ Cookie ver path domain (low name) val False
           cookie_version = cookie_special "$Version"
           cookie_path = cookie_special "$Path"
           cookie_domain = cookie_special "$Domain"
diff --git a/src/Happstack/Server/HTTP/Client.hs b/src/Happstack/Server/HTTP/Client.hs
--- a/src/Happstack/Server/HTTP/Client.hs
+++ b/src/Happstack/Server/HTTP/Client.hs
@@ -4,6 +4,7 @@
 import Happstack.Server.HTTP.Handler
 import Happstack.Server.HTTP.Types
 import Data.Maybe
+import Control.Monad
 import qualified Data.ByteString.Lazy.Char8 as L 
 
 import System.IO
@@ -43,10 +44,10 @@
   csv v x = x++", " ++ v
 
 unrproxify :: String -> [(String, String)] -> Request -> Request
-unrproxify defaultHost list rq = unproxify rq {rqPaths = host: rqPaths rq}
-  where
-  host::String
-  host = maybe defaultHost (f .B.unpack) $
-         getHeader "host" rq
-  f = maybe defaultHost id . flip lookup list
+unrproxify defaultHost list rq = 
+  let host::String
+      host = fromMaybe defaultHost $ flip lookup list =<< B.unpack `liftM` getHeader "host" rq 
+      newrq = rq {rqPaths = host: rqPaths rq}
+  in  unproxify newrq
+
 
diff --git a/src/Happstack/Server/HTTP/FileServe.hs b/src/Happstack/Server/HTTP/FileServe.hs
--- a/src/Happstack/Server/HTTP/FileServe.hs
+++ b/src/Happstack/Server/HTTP/FileServe.hs
@@ -1,34 +1,54 @@
 {-# LANGUAGE FlexibleContexts, Rank2Types #-}
+-- |File Serving functions
 module Happstack.Server.HTTP.FileServe
     (
+     -- * Content-Type \/ Mime-Type
      MimeMap,
+     mimeTypes,
+     asContentType,
+     guessContentType,
+     guessContentTypeM,
+     -- * Low-Level
+     sendFileResponse,     
+     lazyByteStringResponse,
+     strictByteStringResponse,
+     filePathSendFile,
+     filePathLazy,
+     filePathStrict,
+     -- * High-Level
+     -- ** Serving a single file
+     serveFile,
+     serveFileUsing,
+     -- ** Serving files from a directory
+     fileServe',
+     fileServe,
+     fileServeLazy,
+     fileServeStrict,
+     -- * Other
      blockDotFiles,
+     defaultIxFiles,
      doIndex,
+     doIndex',
+     doIndexLazy,
      doIndexStrict,
      errorwrapper,
-     fileServe,
-     fileServeStrict,
-     isDot,
-     mimeTypes
+     isDot
     ) where
 
-import Control.Exception.Extensible
-
-import Control.Monad.Reader
-import Control.Monad.Trans
-import Data.List
-import Data.Maybe
-import Data.Int
-import Happstack.Server.SimpleHTTP hiding (path)
-import System.Directory
-import System.IO
-import System.Locale(defaultTimeLocale)
-import System.Log.Logger
-import System.Time -- (formatCalendarTime, toUTCTime,TOD(..))
-import qualified Data.ByteString.Char8 as P
+import Control.Exception.Extensible (IOException, SomeException, Exception(fromException), bracket, handleJust)
+import Control.Monad (MonadPlus)
+import Control.Monad.Trans (MonadIO(liftIO))
 import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.ByteString.Char8 as S
+import Data.Maybe (fromMaybe)
+import           Data.Map (Map)
 import qualified Data.Map as Map
-import qualified Happstack.Server.SimpleHTTP as SH
+import Happstack.Server.SimpleHTTP (FilterMonad, ServerMonad(askRq), Request(..), Response(..), WebMonad, toResponse, resultBS, setHeader, forbidden, nullRsFlags, result, require, rsfContentLength, seeOther, ifModifiedSince )
+import System.Directory (doesDirectoryExist, doesFileExist, getModificationTime)
+import System.IO (IOMode(ReadMode), hFileSize, hClose, openBinaryFile)
+import System.FilePath ((</>), addTrailingPathSeparator, joinPath, takeExtension)
+import System.Log.Logger (Priority(DEBUG), logM)
+import System.Time (CalendarTime, toUTCTime)
 
 ioErrors :: SomeException -> Maybe IOException
 ioErrors = fromException
@@ -45,269 +65,287 @@
                      then fmap Just $ readFile loglocation
                      else return Nothing
 
+-- * Mime-Type / Content-Type
 
-type MimeMap = Map.Map String String
+type MimeMap = Map String String
 
-type GetFileFunc = (MonadIO m) =>
-    Map.Map String String
-    -> String
-    -> m (Either String ((ClockTime, Integer), (String, L.ByteString)))
+-- | Ready collection of common mime types.
+-- Except for the first two entries, the mappings come from an Ubuntu 8.04 /etc/mime.types file.
+mimeTypes :: MimeMap
+mimeTypes = Map.fromList [("gz","application/x-gzip"),("cabal","application/x-cabal"),("%","application/x-trash"),("323","text/h323"),("3gp","video/3gpp"),("7z","application/x-7z-compressed"),("abw","application/x-abiword"),("ai","application/postscript"),("aif","audio/x-aiff"),("aifc","audio/x-aiff"),("aiff","audio/x-aiff"),("alc","chemical/x-alchemy"),("art","image/x-jg"),("asc","text/plain"),("asf","video/x-ms-asf"),("asn","chemical/x-ncbi-asn1"),("aso","chemical/x-ncbi-asn1-binary"),("asx","video/x-ms-asf"),("atom","application/atom"),("atomcat","application/atomcat+xml"),("atomsrv","application/atomserv+xml"),("au","audio/basic"),("avi","video/x-msvideo"),("b","chemical/x-molconn-Z"),("bak","application/x-trash"),("bat","application/x-msdos-program"),("bcpio","application/x-bcpio"),("bib","text/x-bibtex"),("bin","application/octet-stream"),("bmp","image/x-ms-bmp"),("boo","text/x-boo"),("book","application/x-maker"),("bsd","chemical/x-crossfire"),("c","text/x-csrc"),("c++","text/x-c++src"),("c3d","chemical/x-chem3d"),("cab","application/x-cab"),("cac","chemical/x-cache"),("cache","chemical/x-cache"),("cap","application/cap"),("cascii","chemical/x-cactvs-binary"),("cat","application/vnd.ms-pki.seccat"),("cbin","chemical/x-cactvs-binary"),("cbr","application/x-cbr"),("cbz","application/x-cbz"),("cc","text/x-c++src"),("cdf","application/x-cdf"),("cdr","image/x-coreldraw"),("cdt","image/x-coreldrawtemplate"),("cdx","chemical/x-cdx"),("cdy","application/vnd.cinderella"),("cef","chemical/x-cxf"),("cer","chemical/x-cerius"),("chm","chemical/x-chemdraw"),("chrt","application/x-kchart"),("cif","chemical/x-cif"),("class","application/java-vm"),("cls","text/x-tex"),("cmdf","chemical/x-cmdf"),("cml","chemical/x-cml"),("cod","application/vnd.rim.cod"),("com","application/x-msdos-program"),("cpa","chemical/x-compass"),("cpio","application/x-cpio"),("cpp","text/x-c++src"),("cpt","application/mac-compactpro"),("crl","application/x-pkcs7-crl"),("crt","application/x-x509-ca-cert"),("csf","chemical/x-cache-csf"),("csh","application/x-csh"),("csm","chemical/x-csml"),("csml","chemical/x-csml"),("css","text/css"),("csv","text/csv"),("ctab","chemical/x-cactvs-binary"),("ctx","chemical/x-ctx"),("cu","application/cu-seeme"),("cub","chemical/x-gaussian-cube"),("cxf","chemical/x-cxf"),("cxx","text/x-c++src"),("d","text/x-dsrc"),("dat","chemical/x-mopac-input"),("dcr","application/x-director"),("deb","application/x-debian-package"),("dif","video/dv"),("diff","text/x-diff"),("dir","application/x-director"),("djv","image/vnd.djvu"),("djvu","image/vnd.djvu"),("dl","video/dl"),("dll","application/x-msdos-program"),("dmg","application/x-apple-diskimage"),("dms","application/x-dms"),("doc","application/msword"),("dot","application/msword"),("dv","video/dv"),("dvi","application/x-dvi"),("dx","chemical/x-jcamp-dx"),("dxr","application/x-director"),("emb","chemical/x-embl-dl-nucleotide"),("embl","chemical/x-embl-dl-nucleotide"),("eml","message/rfc822"),("ent","chemical/x-ncbi-asn1-ascii"),("eps","application/postscript"),("etx","text/x-setext"),("exe","application/x-msdos-program"),("ez","application/andrew-inset"),("fb","application/x-maker"),("fbdoc","application/x-maker"),("fch","chemical/x-gaussian-checkpoint"),("fchk","chemical/x-gaussian-checkpoint"),("fig","application/x-xfig"),("flac","application/x-flac"),("fli","video/fli"),("fm","application/x-maker"),("frame","application/x-maker"),("frm","application/x-maker"),("gal","chemical/x-gaussian-log"),("gam","chemical/x-gamess-input"),("gamin","chemical/x-gamess-input"),("gau","chemical/x-gaussian-input"),("gcd","text/x-pcs-gcd"),("gcf","application/x-graphing-calculator"),("gcg","chemical/x-gcg8-sequence"),("gen","chemical/x-genbank"),("gf","application/x-tex-gf"),("gif","image/gif"),("gjc","chemical/x-gaussian-input"),("gjf","chemical/x-gaussian-input"),("gl","video/gl"),("gnumeric","application/x-gnumeric"),("gpt","chemical/x-mopac-graph"),("gsf","application/x-font"),("gsm","audio/x-gsm"),("gtar","application/x-gtar"),("h","text/x-chdr"),("h++","text/x-c++hdr"),("hdf","application/x-hdf"),("hh","text/x-c++hdr"),("hin","chemical/x-hin"),("hpp","text/x-c++hdr"),("hqx","application/mac-binhex40"),("hs","text/x-haskell"),("hta","application/hta"),("htc","text/x-component"),("htm","text/html"),("html","text/html"),("hxx","text/x-c++hdr"),("ica","application/x-ica"),("ice","x-conference/x-cooltalk"),("ico","image/x-icon"),("ics","text/calendar"),("icz","text/calendar"),("ief","image/ief"),("iges","model/iges"),("igs","model/iges"),("iii","application/x-iphone"),("inp","chemical/x-gamess-input"),("ins","application/x-internet-signup"),("iso","application/x-iso9660-image"),("isp","application/x-internet-signup"),("ist","chemical/x-isostar"),("istr","chemical/x-isostar"),("jad","text/vnd.sun.j2me.app-descriptor"),("jar","application/java-archive"),("java","text/x-java"),("jdx","chemical/x-jcamp-dx"),("jmz","application/x-jmol"),("jng","image/x-jng"),("jnlp","application/x-java-jnlp-file"),("jpe","image/jpeg"),("jpeg","image/jpeg"),("jpg","image/jpeg"),("js","application/x-javascript"),("kar","audio/midi"),("key","application/pgp-keys"),("kil","application/x-killustrator"),("kin","chemical/x-kinemage"),("kml","application/vnd.google-earth.kml+xml"),("kmz","application/vnd.google-earth.kmz"),("kpr","application/x-kpresenter"),("kpt","application/x-kpresenter"),("ksp","application/x-kspread"),("kwd","application/x-kword"),("kwt","application/x-kword"),("latex","application/x-latex"),("lha","application/x-lha"),("lhs","text/x-literate-haskell"),("lsf","video/x-la-asf"),("lsx","video/x-la-asf"),("ltx","text/x-tex"),("lyx","application/x-lyx"),("lzh","application/x-lzh"),("lzx","application/x-lzx"),("m3u","audio/mpegurl"),("m4a","audio/mpeg"),("maker","application/x-maker"),("man","application/x-troff-man"),("mcif","chemical/x-mmcif"),("mcm","chemical/x-macmolecule"),("mdb","application/msaccess"),("me","application/x-troff-me"),("mesh","model/mesh"),("mid","audio/midi"),("midi","audio/midi"),("mif","application/x-mif"),("mm","application/x-freemind"),("mmd","chemical/x-macromodel-input"),("mmf","application/vnd.smaf"),("mml","text/mathml"),("mmod","chemical/x-macromodel-input"),("mng","video/x-mng"),("moc","text/x-moc"),("mol","chemical/x-mdl-molfile"),("mol2","chemical/x-mol2"),("moo","chemical/x-mopac-out"),("mop","chemical/x-mopac-input"),("mopcrt","chemical/x-mopac-input"),("mov","video/quicktime"),("movie","video/x-sgi-movie"),("mp2","audio/mpeg"),("mp3","audio/mpeg"),("mp4","video/mp4"),("mpc","chemical/x-mopac-input"),("mpe","video/mpeg"),("mpeg","video/mpeg"),("mpega","audio/mpeg"),("mpg","video/mpeg"),("mpga","audio/mpeg"),("ms","application/x-troff-ms"),("msh","model/mesh"),("msi","application/x-msi"),("mvb","chemical/x-mopac-vib"),("mxu","video/vnd.mpegurl"),("nb","application/mathematica"),("nc","application/x-netcdf"),("nwc","application/x-nwc"),("o","application/x-object"),("oda","application/oda"),("odb","application/vnd.oasis.opendocument.database"),("odc","application/vnd.oasis.opendocument.chart"),("odf","application/vnd.oasis.opendocument.formula"),("odg","application/vnd.oasis.opendocument.graphics"),("odi","application/vnd.oasis.opendocument.image"),("odm","application/vnd.oasis.opendocument.text-master"),("odp","application/vnd.oasis.opendocument.presentation"),("ods","application/vnd.oasis.opendocument.spreadsheet"),("odt","application/vnd.oasis.opendocument.text"),("oga","audio/ogg"),("ogg","application/ogg"),("ogv","video/ogg"),("ogx","application/ogg"),("old","application/x-trash"),("otg","application/vnd.oasis.opendocument.graphics-template"),("oth","application/vnd.oasis.opendocument.text-web"),("otp","application/vnd.oasis.opendocument.presentation-template"),("ots","application/vnd.oasis.opendocument.spreadsheet-template"),("ott","application/vnd.oasis.opendocument.text-template"),("oza","application/x-oz-application"),("p","text/x-pascal"),("p7r","application/x-pkcs7-certreqresp"),("pac","application/x-ns-proxy-autoconfig"),("pas","text/x-pascal"),("pat","image/x-coreldrawpattern"),("patch","text/x-diff"),("pbm","image/x-portable-bitmap"),("pcap","application/cap"),("pcf","application/x-font"),("pcf.Z","application/x-font"),("pcx","image/pcx"),("pdb","chemical/x-pdb"),("pdf","application/pdf"),("pfa","application/x-font"),("pfb","application/x-font"),("pgm","image/x-portable-graymap"),("pgn","application/x-chess-pgn"),("pgp","application/pgp-signature"),("php","application/x-httpd-php"),("php3","application/x-httpd-php3"),("php3p","application/x-httpd-php3-preprocessed"),("php4","application/x-httpd-php4"),("phps","application/x-httpd-php-source"),("pht","application/x-httpd-php"),("phtml","application/x-httpd-php"),("pk","application/x-tex-pk"),("pl","text/x-perl"),("pls","audio/x-scpls"),("pm","text/x-perl"),("png","image/png"),("pnm","image/x-portable-anymap"),("pot","text/plain"),("ppm","image/x-portable-pixmap"),("pps","application/vnd.ms-powerpoint"),("ppt","application/vnd.ms-powerpoint"),("prf","application/pics-rules"),("prt","chemical/x-ncbi-asn1-ascii"),("ps","application/postscript"),("psd","image/x-photoshop"),("py","text/x-python"),("pyc","application/x-python-code"),("pyo","application/x-python-code"),("qt","video/quicktime"),("qtl","application/x-quicktimeplayer"),("ra","audio/x-pn-realaudio"),("ram","audio/x-pn-realaudio"),("rar","application/rar"),("ras","image/x-cmu-raster"),("rd","chemical/x-mdl-rdfile"),("rdf","application/rdf+xml"),("rgb","image/x-rgb"),("rhtml","application/x-httpd-eruby"),("rm","audio/x-pn-realaudio"),("roff","application/x-troff"),("ros","chemical/x-rosdal"),("rpm","application/x-redhat-package-manager"),("rss","application/rss+xml"),("rtf","application/rtf"),("rtx","text/richtext"),("rxn","chemical/x-mdl-rxnfile"),("sct","text/scriptlet"),("sd","chemical/x-mdl-sdfile"),("sd2","audio/x-sd2"),("sda","application/vnd.stardivision.draw"),("sdc","application/vnd.stardivision.calc"),("sdd","application/vnd.stardivision.impress"),("sdf","application/vnd.stardivision.math"),("sds","application/vnd.stardivision.chart"),("sdw","application/vnd.stardivision.writer"),("ser","application/java-serialized-object"),("sgf","application/x-go-sgf"),("sgl","application/vnd.stardivision.writer-global"),("sh","application/x-sh"),("shar","application/x-shar"),("shtml","text/html"),("sid","audio/prs.sid"),("sik","application/x-trash"),("silo","model/mesh"),("sis","application/vnd.symbian.install"),("sisx","x-epoc/x-sisx-app"),("sit","application/x-stuffit"),("sitx","application/x-stuffit"),("skd","application/x-koan"),("skm","application/x-koan"),("skp","application/x-koan"),("skt","application/x-koan"),("smi","application/smil"),("smil","application/smil"),("snd","audio/basic"),("spc","chemical/x-galactic-spc"),("spl","application/futuresplash"),("spx","audio/ogg"),("src","application/x-wais-source"),("stc","application/vnd.sun.xml.calc.template"),("std","application/vnd.sun.xml.draw.template"),("sti","application/vnd.sun.xml.impress.template"),("stl","application/vnd.ms-pki.stl"),("stw","application/vnd.sun.xml.writer.template"),("sty","text/x-tex"),("sv4cpio","application/x-sv4cpio"),("sv4crc","application/x-sv4crc"),("svg","image/svg+xml"),("svgz","image/svg+xml"),("sw","chemical/x-swissprot"),("swf","application/x-shockwave-flash"),("swfl","application/x-shockwave-flash"),("sxc","application/vnd.sun.xml.calc"),("sxd","application/vnd.sun.xml.draw"),("sxg","application/vnd.sun.xml.writer.global"),("sxi","application/vnd.sun.xml.impress"),("sxm","application/vnd.sun.xml.math"),("sxw","application/vnd.sun.xml.writer"),("t","application/x-troff"),("tar","application/x-tar"),("taz","application/x-gtar"),("tcl","application/x-tcl"),("tex","text/x-tex"),("texi","application/x-texinfo"),("texinfo","application/x-texinfo"),("text","text/plain"),("tgf","chemical/x-mdl-tgf"),("tgz","application/x-gtar"),("tif","image/tiff"),("tiff","image/tiff"),("tk","text/x-tcl"),("tm","text/texmacs"),("torrent","application/x-bittorrent"),("tr","application/x-troff"),("ts","text/texmacs"),("tsp","application/dsptype"),("tsv","text/tab-separated-values"),("txt","text/plain"),("udeb","application/x-debian-package"),("uls","text/iuls"),("ustar","application/x-ustar"),("val","chemical/x-ncbi-asn1-binary"),("vcd","application/x-cdlink"),("vcf","text/x-vcard"),("vcs","text/x-vcalendar"),("vmd","chemical/x-vmd"),("vms","chemical/x-vamas-iso14976"),("vrm","x-world/x-vrml"),("vrml","model/vrml"),("vsd","application/vnd.visio"),("wad","application/x-doom"),("wav","audio/x-wav"),("wax","audio/x-ms-wax"),("wbmp","image/vnd.wap.wbmp"),("wbxml","application/vnd.wap.wbxml"),("wk","application/x-123"),("wm","video/x-ms-wm"),("wma","audio/x-ms-wma"),("wmd","application/x-ms-wmd"),("wml","text/vnd.wap.wml"),("wmlc","application/vnd.wap.wmlc"),("wmls","text/vnd.wap.wmlscript"),("wmlsc","application/vnd.wap.wmlscriptc"),("wmv","video/x-ms-wmv"),("wmx","video/x-ms-wmx"),("wmz","application/x-ms-wmz"),("wp5","application/wordperfect5.1"),("wpd","application/wordperfect"),("wrl","model/vrml"),("wsc","text/scriptlet"),("wvx","video/x-ms-wvx"),("wz","application/x-wingz"),("xbm","image/x-xbitmap"),("xcf","application/x-xcf"),("xht","application/xhtml+xml"),("xhtml","application/xhtml+xml"),("xlb","application/vnd.ms-excel"),("xls","application/vnd.ms-excel"),("xlt","application/vnd.ms-excel"),("xml","application/xml"),("xpi","application/x-xpinstall"),("xpm","image/x-xpixmap"),("xsl","application/xml"),("xtel","chemical/x-xtel"),("xul","application/vnd.mozilla.xul+xml"),("xwd","image/x-xwindowdump"),("xyz","chemical/x-xyz"),("zip","application/zip"),("zmt","chemical/x-mopac-input"),("~","application/x-trash")]
 
 
+guessContentType :: MimeMap -> FilePath -> Maybe String
+guessContentType mimeMap filepath =
+    case getExt filepath of
+      "" -> Nothing
+      ext -> Map.lookup ext mimeMap
 
-doIndex :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
-           [String] -> MimeMap -> String -> m Response
-doIndex = doIndex' getFile
+guessContentTypeM :: (Monad m) => MimeMap -> (FilePath -> m String)
+guessContentTypeM mimeMap filePath = return $ fromMaybe "text/plain" $ guessContentType mimeMap filePath
 
--- | A variant of 'doIndex' that relies on 'getFileStrict'
-doIndexStrict :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
-                 [String] -> MimeMap -> String -> m Response
-doIndexStrict = doIndex' getFileStrict
+asContentType :: (Monad m) => String -> (FilePath -> m String)
+asContentType = const . return
 
+defaultIxFiles :: [String]
+defaultIxFiles= ["index.html","index.xml","index.gif"]
 
-doIndex' :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
-            GetFileFunc
-         -> [String]
-         -> MimeMap
-         -> String
-         -> m Response
-doIndex' _getFileFunc []           _mime _fp = forbidden $ toResponse "Directory index forbidden"
-doIndex'  getFileFunc (index:rest)  mime  fp =
-    do
-    let path = fp++'/':index
-    --print path
-    fe <- liftIO $ doesFileExist path
-    if fe then retFile path else doIndex rest mime fp
-    where retFile = returnFile getFileFunc mime
+fileNotFound :: (Monad m, FilterMonad Response m) => FilePath -> m Response
+fileNotFound fp = return $ result 404 $ "File not found " ++ fp
 
+-- | Similar to 'takeExtension' but does not include the extension separator char
+getExt :: FilePath -> String
+getExt fp = drop 1 $ takeExtension fp
 
+-- | Prevents files of the form '.foo' or 'bar/.foo' from being served
+blockDotFiles :: (Request -> IO Response) -> Request -> IO Response
+blockDotFiles fn rq
+    | isDot (joinPath (rqPaths rq)) = return $ result 403 "Dot files not allowed."
+    | otherwise = fn rq
 
-defaultIxFiles :: [String]
-defaultIxFiles= ["index.html","index.xml","index.gif"]
+-- | Returns True if the given String either starts with a . or is of the form
+-- "foo/.bar", e.g. the typical *nix convention for hidden files.
+isDot :: String -> Bool
+isDot = isD . reverse
+    where
+    isD ('.':'/':_) = True
+    isD ['.']       = True
+    --isD ('/':_)     = False
+    isD (_:cs)      = isD cs
+    isD []          = False
 
+-- * Low-level functions for generating a Response
 
--- | Serve a file (lazy version). For efficiency reasons when serving large
--- files, will escape the computation early if a file is successfully served,
--- to prevent filters from being applied; if a filter were applied, we would
--- need to compute the content-length (thereby forcing the spine of the
--- ByteString into memory) rather than reading it from the filesystem.
+-- | Use sendFile to send the contents of a Handle
+sendFileResponse :: String  -- ^ content-type string
+                 -> FilePath  -- ^ file path for content to send
+                 -> Maybe (CalendarTime, Request) -- ^ mod-time for the handle (MUST NOT be later than server's time of message origination), incoming request (used to check for if-modified-since header)
+                 -> Integer -- ^ offset into Handle
+                 -> Integer -- ^ number of bytes to send
+                 -> Response
+sendFileResponse ct filePath mModTime _offset count =
+    let res = ((setHeader "Content-Length" (show count)) .
+               (setHeader "Content-Type" ct) $ 
+               (SendFile 200 Map.empty nullRsFlags{rsfContentLength=False} Nothing filePath 0 count)
+              )
+    in case mModTime of
+         Nothing -> res
+         (Just (modTime, request)) -> ifModifiedSince modTime request res
+
+-- | Send the contents of a Lazy ByteString
+lazyByteStringResponse :: String   -- ^ content-type string (e.g. @\"text/plain; charset=utf-8\"@)
+                       -> L.ByteString   -- ^ lazy bytestring content to send
+                       -> Maybe (CalendarTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)
+                       -> Integer -- ^ offset into the bytestring
+                       -> Integer -- ^ number of bytes to send (offset + count must be less than or equal to the length of the bytestring)
+                       -> Response
+lazyByteStringResponse ct body mModTime offset count =
+    let res = ((setHeader "Content-Type" ct) $
+               resultBS 200 (L.take (fromInteger count) $ (L.drop (fromInteger offset))  body)
+              )
+    in case mModTime of
+         Nothing -> res
+         (Just (modTime, request)) -> ifModifiedSince modTime request res
+
+-- | Send the contents of a Lazy ByteString
+strictByteStringResponse :: String   -- ^ content-type string (e.g. @\"text/plain; charset=utf-8\"@)
+                         -> S.ByteString   -- ^ lazy bytestring content to send
+                         -> Maybe (CalendarTime, Request) -- ^ mod-time for the bytestring, incoming request (used to check for if-modified-since header)
+                         -> Integer -- ^ offset into the bytestring
+                         -> Integer -- ^ number of bytes to send (offset + count must be less than or equal to the length of the bytestring)
+                         -> Response
+strictByteStringResponse ct body mModTime offset count =
+    let res = ((setHeader "Content-Type" ct) $
+               resultBS 200 (L.fromChunks [S.take (fromInteger count) $ S.drop (fromInteger offset) body])
+              )
+    in case mModTime of
+         Nothing -> res
+         (Just (modTime, request)) -> ifModifiedSince modTime request res
+
+-- | Send the specified file with the specified mime-type using sendFile()
 --
--- Note that using lazy fileServe can result in some filehandles staying open
--- until the garbage collector gets around to closing them.
-fileServe :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m) =>
-             [FilePath]         -- ^ index files if the path is a directory
-          -> FilePath           -- ^ file/directory to serve
-          -> m Response
-fileServe ixFiles localpath = do
-    resp <- fileServe' localpath
-                       (doIndex (ixFiles++defaultIxFiles))
-                       mimeTypes
-                       getFile
+-- NOTE: assumes file exists and is readable by the server. See 'serveFileUsing'.
+--
+-- WARNING: No security checks are performed.
+filePathSendFile :: (ServerMonad m, MonadIO m)
+                 => String   -- ^ content-type string
+                 -> FilePath -- ^ path to file on disk
+                 -> m Response
+filePathSendFile contentType fp =
+    do handle  <- liftIO $ openBinaryFile fp ReadMode -- garbage collection should close this
+       modtime <- liftIO $ getModificationTime fp
+       count   <- liftIO $ hFileSize handle
+       rq      <- askRq
+       return $ sendFileResponse contentType fp (Just (toUTCTime modtime, rq)) 0 count
 
-    escape' $ resp { rsFlags = RsFlags {rsfContentLength=False} }
+-- | Send the specified file with the specified mime-type using Lazy ByteStrings
+--
+-- NOTE: assumes file exists and is readable by the server. See 'serveFileUsing'.
+--
+-- WARNING: No security checks are performed.
+filePathLazy :: (ServerMonad m, MonadIO m)
+                 => String   -- ^ content-type string
+                 -> FilePath -- ^ path to file on disk
+                 -> m Response
+filePathLazy contentType fp =
+    do handle  <- liftIO $ openBinaryFile fp ReadMode -- garbage collection should close this
+       contents <- liftIO $ L.hGetContents handle
+       modtime  <- liftIO $ getModificationTime fp
+       count    <- liftIO $ hFileSize handle
+       rq       <- askRq
+       return $ lazyByteStringResponse contentType contents (Just (toUTCTime modtime, rq)) 0 count
 
+-- | Send the specified file with the specified mime-type using Lazy ByteStrings
+--
+-- NOTE: assumes file exists and is readable by the server. See 'serveFileUsing'.
+--
+-- WARNING: No security checks are performed.
+filePathStrict :: (ServerMonad m, MonadIO m)
+                 => String   -- ^ content-type string
+                 -> FilePath -- ^ path to file on disk
+                 -> m Response
+filePathStrict contentType fp =
+    do contents <- liftIO $ S.readFile fp
+       modtime  <- liftIO $ getModificationTime fp
+       count    <- liftIO $ bracket (openBinaryFile fp ReadMode) hClose hFileSize
+       rq       <- askRq
+       return $ strictByteStringResponse contentType contents (Just (toUTCTime modtime, rq)) 0 count
 
+-- * High-level functions for serving files
 
--- | Serve a file (strict version). Reads the entire file strictly into
--- memory, and ensures that the handle is properly closed. Unlike lazy
--- fileServe, this function doesn't shortcut the computation early, and it
--- allows for filtering (ex: gzip compression) to be applied
-fileServeStrict :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
-                   [FilePath]   -- ^ index files if the path is a directory
-                -> FilePath     -- ^ file/directory to serve
-                -> m Response
-fileServeStrict ixFiles localpath = do
-    resp <- fileServe' localpath
-                       (doIndex (ixFiles++defaultIxFiles))
-                       mimeTypes
-                       getFileStrict
 
-    -- clear "Content-Length" because it could be modified by filters
-    -- downstream
-    let headers = rsHeaders resp
-    return $ resp {rsHeaders = Map.delete (P.pack "content-length") headers}
+-- ** Serve a single file
 
+-- | Serve a single, specified file.
+-- 
+-- example 1:
+-- 
+--  Serve using sendfile() and the specified content-type
+--
+-- > serveFileUsing filePathSendFile (asContentType "image/jpeg") "/srv/data/image.jpg"
+--
+--
+-- example 2:
+-- 
+--  Serve using a lazy ByteString and the guess the content-type from the extension
+-- 
+-- > serveFileUsing filePathLazy (guessContentTypeM mimeTypes) "/srv/data/image.jpg"
+-- 
+-- WARNING: No security checks are performed.
+serveFileUsing :: (ServerMonad m, FilterMonad Response m, MonadIO m) 
+               => (String -> FilePath -> m Response) -- ^ typically 'filePathSendFile', 'filePathLazy', or 'filePathStrict'
+               -> (FilePath -> m String)  -- ^ function for determining content-type of file. Typically 'asContentType' or 'guessContentTypeM'
+               -> FilePath -- ^ path to the file to serve
+               -> m Response
+serveFileUsing serveFn mimeFn fp = 
+    do fe <- liftIO $ doesFileExist fp
+       if fe
+          then do mt <- mimeFn fp
+                  serveFn mt fp
+          else fileNotFound fp
 
+-- | Alias for 'serveFileUsing' 'filePathSendFile'
+serveFile :: (ServerMonad m, FilterMonad Response m, MonadIO m) => (FilePath -> m String) -> FilePath -> m Response
+serveFile = serveFileUsing filePathSendFile
 
--- | Serve files with a mime type map under a directory.
---   Uses the function to transform URIs to FilePaths.
-fileServe' :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
-              String
-              -> (Map.Map String String -> String -> m Response)
-              -> Map.Map String String
-              -> GetFileFunc
-              -> m Response
-fileServe' localpath fdir mime getFileFunc = do
+-- ** Serve files from a directory
+
+-- | Serve files from a directory and it's subdirectories (parameterizable version)
+-- 
+-- Parameterize this function to create functions like, 'fileServe', 'fileServeLazy', and 'fileServeStrict'
+--
+-- You supply:
+--
+--  1. a low-level function which takes a content-type and 'FilePath' and generates a Response
+--  2. a function which determines the content-type from the 'FilePath'
+--  3. a list of all the default index files
+--
+-- NOTE: unlike fileServe, there are no index files by default. See 'defaultIxFiles'.
+fileServe' :: ( WebMonad Response m
+              , ServerMonad m
+              , FilterMonad Response m
+              , MonadIO m
+              ) 
+           => (String -> FilePath -> m Response) -- ^ function which takes a content-type and filepath and generates a response (typically 'filePathSendFile', 'filePathLazy', or 'filePathStrict')
+           -> (FilePath -> m String) -- ^ function which returns the mime-type for FilePath
+           -> [FilePath]         -- ^ index files if the path is a directory
+           -> FilePath           -- ^ file/directory to serve
+           -> m Response
+fileServe' serveFn mimeFn ixFiles localpath = do
     rq <- askRq
-    let fp2 = takeWhile (/=',') fp
-        fp = filepath
-        safepath = filter (\x->not (null x) && head x /= '.') (rqPaths rq)
-        filepath = intercalate "/"  (localpath:safepath)
-        fp' = if null safepath then "" else last safepath
-    if "TESTH" `isPrefixOf` fp'
-        then renderResponse mime $ fakeFile $ (read $ drop 5 $ fp' :: Integer)
-        else do
+    let safepath = filter (\x->not (null x) && x /= ".." && x /= ".") (rqPaths rq)
+        fp = joinPath  (localpath:safepath)
     fe <- liftIO $ doesFileExist fp
-    fe2 <- liftIO $ doesFileExist fp2
     de <- liftIO $ doesDirectoryExist fp
-    -- error $ "show ilepath: " ++show (fp,de)
     let status | de   = "DIR"
                | fe   = "file"
-               | fe2  = "group"
                | True = "NOT FOUND"
     liftIO $ logM "Happstack.Server.HTTP.FileServe" DEBUG ("fileServe: "++show fp++" \t"++status)
-    if de then fdir mime fp else do
-    getFileFunc mime fp >>= flip either (renderResponse mime)
-        (const $ returnGroup localpath mime safepath)
-
-
-returnFile :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
-              GetFileFunc -> Map.Map String String -> String -> m Response
-returnFile getFileFunc mime fp =
-    getFileFunc mime fp >>=  either fileNotFound (renderResponse mime)
-
-
--- if fp has , separated then return concatenation with content-type of last
--- and last modified of latest
-tr :: (Eq a) => a -> a -> [a] -> [a]
-tr a b = map (\x->if x==a then b else x)
-ltrim :: String -> String
-ltrim = dropWhile (flip elem " \t\r")
-
-returnGroup :: (ServerMonad m, FilterMonad Response m, MonadIO m) =>
-               String -> Map.Map String String -> [String] -> m Response
-returnGroup localPath mime fp = do
-  let fps0 = map ((:[]). ltrim) $ lines $ tr ',' '\n' $ last fp
-      fps = map (intercalate "/" . ((localPath:init fp) ++)) fps0
-
-  -- if (head $ head fps0)=="TEST" then   renderResponse mime rq fakeFile else do
-
-  mbFiles <-  mapM (getFile mime) $ fps
-  let notFounds = [x | Left x <- mbFiles]
-      files = [x | Right x <- mbFiles]
-  if not $ null notFounds
-    then fileNotFound $ drop (length localPath) $ head notFounds else do
-  let totSize = sum $ map (snd . fst) files
-      maxTime = maximum $ map (fst . fst) files :: ClockTime
-
-  renderResponse mime ((maxTime,totSize),(fst $ snd $ head files,
-                                             L.concat $ map (snd . snd) files))
-
-
-
-fileNotFound :: (Monad m, FilterMonad Response m) => String -> m Response
-fileNotFound fp = return $ result 404 $ "File not found " ++ fp
-
-
---fakeLen = 71* 1024
-fakeFile :: (Integral a) =>
-            a -> ((ClockTime, Int64), (String, L.ByteString))
-fakeFile fakeLen = ((TOD 0 0,L.length body),("text/javascript",body))
-    where
-      body = L.pack $ (("//"++(show len)++" ") ++ ) $ (replicate len '0') ++ "\n"
-      len = fromIntegral fakeLen
-
--- | @getFile mimeMap path@ will lazily read the file as a ByteString
--- with a content type provided by matching the file extension with the
--- @mimeMap@.  getFile will return an error string or ((timeFetched,size), (contentType,fileContents))
-getFile :: (MonadIO m) =>
-           Map.Map String String
-           -> String
-           -> m (Either String ((ClockTime, Integer), (String, L.ByteString)))
-getFile mime fp = do
-  let ct = Map.findWithDefault "text/plain" (getExt fp) mime
-  fe <- liftIO $ doesFileExist fp
-  if not fe then return $ Left fp else do
-
-  time <- liftIO $ getModificationTime fp
-  h    <- liftIO $ openBinaryFile fp ReadMode
-  size <- liftIO $ hFileSize h
-  lbs  <- liftIO $ L.hGetContents h
-  return $ Right ((time,size),(ct,lbs))
-
--- | As 'getFile' but strictly fetches the file, instead of lazily.
-getFileStrict :: (MonadIO m) =>
-                 Map.Map String String
-              -> String
-              -> m (Either String ((ClockTime, Integer), (String, L.ByteString)))
-getFileStrict mime fp = do
-  let ct = Map.findWithDefault "text/plain" (getExt fp) mime
-  fe     <- liftIO $ doesFileExist fp
-
-  if not fe then return $ Left fp else do
-
-  time     <- liftIO $ getModificationTime fp
-  s        <- liftIO $ P.readFile fp
-  let lbs  = L.fromChunks [s]
-  let size = toInteger . P.length $ s
-  return $ Right ((time,size),(ct,lbs))
-
-
-renderResponse :: (Monad m,
-                   ServerMonad m,
-                   FilterMonad Response m,
-                   Show t1) =>
-                  t
-                  -> ((ClockTime, t1), (String, L.ByteString))
-                  -> m Response
-renderResponse _ ((modtime,size),(ct,body)) = do
-  rq <- askRq
-  let notmodified = getHeader "if-modified-since" rq == Just (P.pack $ repr)
-      repr = formatCalendarTime defaultTimeLocale
-             "%a, %d %b %Y %X GMT" (toUTCTime modtime)
-  -- "Mon, 07 Jan 2008 19:51:02 GMT"
-  -- when (isJust $ getHeader "if-modified-since"  rq) $ error $ show $ getHeader "if-modified-since" rq
-  if notmodified then
-      return $ result 304 ""
-    else do
-      return $ ((setHeader "Last-modified" repr) .
-                (setHeader "Content-Length" (show size)) .
-                (setHeader "Content-Type" ct)) $
-               resultBS 200 body
+    if de
+        then if last (rqUri rq) == '/'
+             then doIndex' serveFn mimeFn (ixFiles++defaultIxFiles) fp
+             else do let path' = addTrailingPathSeparator (rqUri rq)
+                     seeOther path' (toResponse path')
+        else if fe 
+                then serveFileUsing serveFn mimeFn fp
+                else fileNotFound fp
 
+-- | Serve files from a directory and it's subdirectories (sendFile version). Should perform much better than its predecessors.
+fileServe :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m) =>
+             [FilePath]         -- ^ index files if the path is a directory
+          -> FilePath           -- ^ file/directory to serve
+          -> m Response
+fileServe ixFiles localPath = fileServe' filePathSendFile (guessContentTypeM mimeTypes) (ixFiles ++ defaultIxFiles) localPath
 
+-- | Serve files from a directory and it's subdirectories (lazy ByteString version).
+-- 
+-- May leak file handles.
+fileServeLazy :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m) =>
+             [FilePath]         -- ^ index files if the path is a directory
+          -> FilePath           -- ^ file/directory to serve
+          -> m Response
+fileServeLazy ixFiles localPath = fileServe' filePathLazy (guessContentTypeM mimeTypes) (ixFiles ++ defaultIxFiles) localPath
 
+-- | Serve files from a directory and it's subdirectories (strict ByteString version). 
+fileServeStrict :: (WebMonad Response m, ServerMonad m, FilterMonad Response m, MonadIO m) =>
+             [FilePath]         -- ^ index files if the path is a directory
+          -> FilePath           -- ^ file/directory to serve
+          -> m Response
+fileServeStrict ixFiles localPath = fileServe' filePathStrict (guessContentTypeM mimeTypes) (ixFiles ++ defaultIxFiles) localPath
 
-getExt :: String -> String
-getExt = reverse . takeWhile (/='.') . reverse
+-- * Index
 
--- | Ready collection of common mime types.
-mimeTypes :: MimeMap
-mimeTypes = Map.fromList
-	    [("xml","application/xml")
-	    ,("xsl","application/xml")
-	    ,("js","text/javascript")
-	    ,("html","text/html")
-	    ,("htm","text/html")
-	    ,("css","text/css")
-	    ,("gif","image/gif")
-	    ,("jpg","image/jpeg")
-	    ,("png","image/png")
-	    ,("txt","text/plain")
-	    ,("doc","application/msword")
-	    ,("exe","application/octet-stream")
-	    ,("pdf","application/pdf")
-	    ,("zip","application/zip")
-	    ,("gz","application/x-gzip")
-	    ,("ps","application/postscript")
-	    ,("rtf","application/rtf")
-	    ,("wav","application/x-wav")
-	    ,("hs","text/plain")]
+doIndex :: (ServerMonad m, FilterMonad Response m, MonadIO m)
+        => [String]
+        -> MimeMap
+        -> String
+        -> m Response
+doIndex ixFiles mimeMap localPath = doIndex' filePathSendFile (guessContentTypeM mimeMap) ixFiles localPath
 
+doIndexLazy :: (ServerMonad m, FilterMonad Response m, MonadIO m)
+        => [String]
+        -> MimeMap
+        -> String
+        -> m Response
+doIndexLazy ixFiles mimeMap localPath = doIndex' filePathLazy (guessContentTypeM mimeMap) ixFiles localPath
 
--- | Prevents files of the form '.foo' or 'bar/.foo' from being served
-blockDotFiles :: (Request -> IO Response) -> Request -> IO Response
-blockDotFiles fn rq
-    | isDot (intercalate "/" (rqPaths rq)) = return $ result 403 "Dot files not allowed."
-    | otherwise = fn rq
+doIndexStrict :: (ServerMonad m, FilterMonad Response m, MonadIO m)
+        => [String]
+        -> MimeMap
+        -> String
+        -> m Response
+doIndexStrict ixFiles mimeMap localPath = doIndex' filePathStrict (guessContentTypeM mimeMap) ixFiles localPath
 
--- | Returns True if the given String either starts with a . or is of the form
--- "foo/.bar", e.g. the typical *nix convention for hidden files.
-isDot :: String -> Bool
-isDot = isD . reverse
-    where
-    isD ('.':'/':_) = True
-    isD ['.']       = True
-    --isD ('/':_)     = False
-    isD (_:cs)      = isD cs
-    isD []          = False
+doIndex' :: (ServerMonad m, FilterMonad Response m, MonadIO m)
+        => (String -> FilePath -> m Response)
+        -> (FilePath -> m String)
+        -> [String]
+        -> String
+        -> m Response
+doIndex' _serveFn _mime  []          _fp = forbidden $ toResponse "Directory index forbidden"
+doIndex'  serveFn mimeFn (index:rest) fp =
+    do let path = fp </> index
+       fe <- liftIO $ doesFileExist path
+       if fe 
+          then serveFileUsing serveFn mimeFn path 
+          else doIndex' serveFn mimeFn rest fp
diff --git a/src/Happstack/Server/HTTP/Handler.hs b/src/Happstack/Server/HTTP/Handler.hs
--- a/src/Happstack/Server/HTTP/Handler.hs
+++ b/src/Happstack/Server/HTTP/Handler.hs
@@ -33,6 +33,8 @@
 import Happstack.Util.TimeOut
 import Happstack.Util.LogFormat (formatRequestCombined)
 import Data.Time.Clock (getCurrentTime)
+import Network.Socket (Socket, fdSocket)
+import Network.Socket.SendFile (unsafeSendFile')
 import System.Log.Logger (Priority(..), logM)
 
 request :: Conf -> Handle -> Host -> (Request -> IO Response) -> IO ()
@@ -84,18 +86,7 @@
                          user = "-"
                          requestLn = unwords [show $ rqMethod req, rqUri req, show $ rqVersion req]
                          responseCode = rsCode res
-                         sendContentLength = rsfContentLength (rsFlags res)
-
-                         -- don't force the bytestring if "sendContentLength"
-                         -- is false, at least not if a content-length header
-                         -- has been set
-                         size = if not sendContentLength then
-                                    maybe (toInteger $ L.length $ rsBody res)
-                                          ((read . P.unpack) :: P.ByteString -> Integer)
-                                          (getHeaderBS contentLengthC req)
-                                  else
-                                    toInteger $ L.length $ rsBody res
-
+                         size = maybe (-1) (read . B.unpack) (getHeader "Content-Length" res) -- -1 indicates unknown size
                          referer = B.unpack $ fromMaybe (B.pack "") $ getHeader "Referer" req
                          userAgent = B.unpack $ fromMaybe (B.pack "") $ getHeader "User-Agent" req
                      logM "Happstack.Server.AccessLog.Combined" INFO $ formatRequestCombined host' user time requestLn responseCode size referer userAgent
@@ -192,29 +183,45 @@
     foldr (uncurry setHeaderBS) (mkHeaders [])
     [ (serverC, happsC), (contentTypeC, textHtmlC) ]
 
+-- FIXME: we should not be controlling the response headers in mysterious ways in this low level code
+-- headers should be set by application code and the core http engine should be very lean.
 putAugmentedResult :: Handle -> Request -> Response -> IO ()
-putAugmentedResult h req res = do
-  let ph (HeaderPair k vs) = map (\v -> P.concat [k, fsepC, v, crlfC]) vs
-  raw <- getApproximateTime
-  let cl = L.length $ rsBody res
-  let put = P.hPut h
-  -- TODO: Hoist static headers to the toplevel.
-  let stdHeaders = staticHeaders `M.union`
-                   M.fromList ( [ (dateCLower,       HeaderPair dateC [raw])
-                                , (connectionCLower, HeaderPair connectionC [if continueHTTP req res then keepAliveC else closeC])
-                                ] ++ if rsfContentLength (rsFlags res)
-                                     then [(contentlengthC, HeaderPair contentLengthC [P.pack (show cl)])]
-                                     else [] )
-      allHeaders = rsHeaders res `M.union` stdHeaders  -- 'union' prefers 'headers res' when duplicate keys are encountered.
+putAugmentedResult outp req res = do
+    case res of
+        -- standard bytestring response
+        Response {} -> do
+            sendTop (fromIntegral (L.length (rsBody res)))
+            when (rqMethod req /= HEAD) (L.hPut outp $ rsBody res)
+        -- zero-copy sendfile response
+        -- the handle *should* be closed by the garbage collector
+        SendFile {} -> do
+            let infp = sfFilePath res
+                off = sfOffset res
+                count = sfCount res
+            sendTop count
+            unsafeSendFile' outp infp off count
+    hFlush outp
+    where ph (HeaderPair k vs) = map (\v -> P.concat [k, fsepC, v, crlfC]) vs
+          sendTop cl = do
+              allHeaders <- augmentHeaders req res cl
+              mapM_ (P.hPut outp) $ concat
+                [ (pversion $ rqVersion req)          -- Print HTTP version
+                , [responseMessage $ rsCode res]      -- Print responseCode
+                , concatMap ph (M.elems allHeaders)   -- Print all headers
+                , [crlfC]
+                ]
 
-  mapM_ put $ concat
-    [ (pversion $ rqVersion req)          -- Print HTTP version
-    , [responseMessage $ rsCode res]      -- Print responseCode
-    , concatMap ph (M.elems allHeaders)   -- Print all headers
-    , [crlfC]
-    ]
-  when (rqMethod req /= HEAD) $ L.hPut h $ rsBody res
-  hFlush h
+augmentHeaders :: Request -> Response -> Integer -> IO Headers
+augmentHeaders req res cl = do
+    -- TODO: Hoist static headers to the toplevel.
+    raw <- getApproximateTime
+    let stdHeaders = staticHeaders `M.union`
+          M.fromList ( [ (dateCLower,       HeaderPair dateC [raw])
+                       , (connectionCLower, HeaderPair connectionC [if continueHTTP req res then keepAliveC else closeC])
+                       ] ++ if rsfContentLength (rsFlags res)
+                              then [(contentlengthC, HeaderPair contentLengthC [P.pack (show cl)])]
+                              else [] )
+    return (rsHeaders res `M.union` stdHeaders) -- 'union' prefers 'headers res' when duplicate keys are encountered.
 
 -- | Serializes the request to the given handle
 putRequest :: Handle -> Request -> IO ()
diff --git a/src/Happstack/Server/HTTP/Listen.hs b/src/Happstack/Server/HTTP/Listen.hs
--- a/src/Happstack/Server/HTTP/Listen.hs
+++ b/src/Happstack/Server/HTTP/Listen.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE CPP, ScopedTypeVariables, PatternSignatures #-}
-module Happstack.Server.HTTP.Listen(listen) where
+module Happstack.Server.HTTP.Listen(listen, listen') where
 
 import Happstack.Server.HTTP.Types
 import Happstack.Server.HTTP.Handler
 import Happstack.Server.HTTP.Socket (acceptLite)
 import Control.Exception.Extensible as E
 import Control.Concurrent
-import Network(PortID(..), listenOn, sClose)
+import Network(PortID(..), listenOn, sClose, Socket)
 import System.IO
 {-
 #ifndef mingw32_HOST_OS
@@ -19,8 +19,16 @@
 log':: Priority -> String -> IO ()
 log' = logM "Happstack.Server.HTTP.Listen"
 
+-- | Bind and listen port
 listen :: Conf -> (Request -> IO Response) -> IO ()
 listen conf hand = do
+    let port' = port conf
+    socket <- listenOn (PortNumber $ toEnum port')
+    listen' socket conf hand
+
+-- | Use a previously bind port and listen
+listen' :: Socket -> Conf -> (Request -> IO Response) -> IO ()
+listen' s conf hand = do
 {-
 #ifndef mingw32_HOST_OS
 -}
@@ -30,7 +38,6 @@
 -}
   let port' = port conf
   log' NOTICE ("Listening on port " ++ show port')
-  s <- listenOn $ PortNumber $ toEnum port'
   let work (h,hn,p) = do -- hSetBuffering h NoBuffering
                          let eh (x::SomeException) = log' ERROR ("HTTP request failed with: "++show x)
                          request conf h (hn,fromIntegral p) hand `E.catch` eh
diff --git a/src/Happstack/Server/HTTP/SocketTH.hs b/src/Happstack/Server/HTTP/SocketTH.hs
--- a/src/Happstack/Server/HTTP/SocketTH.hs
+++ b/src/Happstack/Server/HTTP/SocketTH.hs
@@ -8,9 +8,8 @@
 
 -- find out at compile time if the SockAddr6 / HostAddress6 constructors are available
 supportsIPv6 :: Bool
-supportsIPv6 = $(let c = "Network.Socket.SockAddrInet6"; d = ''SockAddr in
+supportsIPv6 = $(let c = ["Network.Socket.SockAddrInet6", "Network.Socket.Internal.SockAddrInet6"] ; d = ''SockAddr in
                  do TyConI (DataD _ _ _ cs _) <- reify d
-                    if isJust (find (\(NormalC n _) -> show n == c) cs)
+                    if isJust (find (\(NormalC n _) -> show n `elem` c) cs)
                        then [| True |]
                        else [| False |] )
-                       
diff --git a/src/Happstack/Server/HTTP/Types.hs b/src/Happstack/Server/HTTP/Types.hs
--- a/src/Happstack/Server/HTTP/Types.hs
+++ b/src/Happstack/Server/HTTP/Types.hs
@@ -29,6 +29,7 @@
 import Happstack.Server.Cookie
 import Data.List
 import Text.Show.Functions ()
+import System.IO (Handle)
 
 -- | HTTP version
 data Version = Version Int Int
@@ -90,12 +91,21 @@
 
 type Host = (String,Int)
 
-data Response  = Response  { rsCode    :: Int,
-                             rsHeaders :: Headers,
-                             rsFlags   :: RsFlags,
-                             rsBody    :: L.ByteString,
-                             rsValidator:: Maybe (Response -> IO Response)
-                           } deriving (Show,Typeable) 
+data Response  = Response  { rsCode      :: Int,
+                             rsHeaders   :: Headers,
+                             rsFlags     :: RsFlags,
+                             rsBody      :: L.ByteString,
+                             rsValidator :: Maybe (Response -> IO Response)
+                           }
+               | SendFile  { rsCode      :: Int,
+                             rsHeaders   :: Headers,
+                             rsFlags     :: RsFlags,
+                             rsValidator :: Maybe (Response -> IO Response),
+                             sfFilePath  :: FilePath,  -- file handle to send from
+                             sfOffset    :: Integer, -- offset to start at
+                             sfCount     :: Integer  -- number of bytes to send
+                           }
+               deriving (Show,Typeable) 
 
 data Request = Request { rqMethod  :: Method,
                          rqPaths   :: [String],
@@ -108,7 +118,6 @@
                          rqBody    :: RqBody,
                          rqPeer    :: Host
                        } deriving(Show,Read,Typeable)
-
 
 -- | Converts a Request into a String representing the corresponding URL
 rqURL :: Request -> String
diff --git a/src/Happstack/Server/MessageWrap.hs b/src/Happstack/Server/MessageWrap.hs
--- a/src/Happstack/Server/MessageWrap.hs
+++ b/src/Happstack/Server/MessageWrap.hs
@@ -18,7 +18,7 @@
                                xs    -> xs)
 
 bodyInput :: Request -> [(String, Input)]
-bodyInput req | rqMethod req /= POST = []
+bodyInput req | (rqMethod req /= POST) && (rqMethod req /= PUT) = []
 bodyInput req =
     let ctype = getHeader "content-type" req >>= parseContentType . P.unpack
         getBS (Body bs) = bs
diff --git a/src/Happstack/Server/Parts.hs b/src/Happstack/Server/Parts.hs
--- a/src/Happstack/Server/Parts.hs
+++ b/src/Happstack/Server/Parts.hs
@@ -137,7 +137,7 @@
         
         encoding1 :: GenParser Char st ([Char], Maybe Double)
         encoding1 = do
-            encoding <- many1 alphaNum <|> string "*"
+            encoding <- many1 (alphaNum <|> char '-') <|> string "*"
             ws
             quality<-optionMaybe qual
             return (encoding, fmap read quality)
diff --git a/src/Happstack/Server/S3.hs b/src/Happstack/Server/S3.hs
deleted file mode 100644
--- a/src/Happstack/Server/S3.hs
+++ /dev/null
@@ -1,240 +0,0 @@
-{-# LANGUAGE PatternGuards #-}
-module Happstack.Server.S3
-    ( newS3        -- :: AccessKey -> SecretKey -> URI -> IO S3
-    , closeS3      -- :: S3 -> IO ()
-    , createBucket -- :: S3 -> BucketId -> IO ()
-    , createObject -- :: S3 -> BucketId -> ObjectId -> String -> IO ()
-    , getObject    -- :: S3 -> BucketId -> ObjectId -> IO String
-    , deleteBucket -- :: S3 -> BucketId -> IO ()
-    , deleteObject -- :: S3 -> BucketId -> ObjectId -> IO ()
-    , listObjects  -- :: S3 -> BucketId -> IO [String]
-    , sendRequest  -- :: S3 -> Request -> IO String
-    , sendRequest_ -- :: S3 -> Request -> IO ()
---    , sendRequests -- :: S3 -> [Request] -> IO ()
-    , BucketId, ObjectId, AccessKey, SecretKey
-    , amazonURI
-    ) where
-
-import Happstack.Crypto.HMAC             ( hmacSHA1 )
-import Happstack.Server.HTTPClient.HTTP
-import qualified Happstack.Server.HTTPClient.Stream as Stream
-
-import Network.URI hiding (path)
-import Control.Concurrent               ( newMVar, modifyMVar, swapMVar
-                                        , modifyMVar_, MVar )
-import Data.Maybe                       ( fromJust, fromMaybe )
-import Data.List                        ( intersperse )
-import System.Time                      ( getClockTime, toCalendarTime
-                                        , formatCalendarTime )
-import System.Locale                    ( defaultTimeLocale, rfc822DateFormat )
-
-import Text.XML.HaXml                   ( xmlParse, Document(..), Content(..) )
-import Text.XML.HaXml.Xtract.Parse      ( xtract )
-
-type BucketId = String
-type ObjectId = String
-type AccessKey = String
-type SecretKey = String
-
-data S3
-    = S3
-    { s3AccessKey        :: AccessKey
-    , s3SecretKey        :: SecretKey
-    , s3URI              :: URI
---    , s3KeepAliveTimeout :: Int
-    , s3Conn             :: MVar (Maybe Connection)
-    }
-
-{- |
-  Sign a request using the access key and secret key from the S3 data
-  type.
--}
-signRequest :: S3 -> Request -> IO Request
-signRequest s3
-    = let akey = s3AccessKey s3
-          skey = s3SecretKey s3
-      in signRequest' akey skey
-
-{- |
-  Fill in necessary information (such as a date header) and then sign
-  then request.
--}
-signRequest' :: AccessKey -> SecretKey -> Request -> IO Request
-signRequest' akey skey request
-    = do now <- getClockTime
-         cal <- toCalendarTime now
-         let isoDate = formatCalendarTime defaultTimeLocale rfc822DateFormat cal
-             auth = fromJust (uriAuthority (rqURI request))
---             authErr = error "S3.hs: internal error: failed to parse authority"
-         let dat = concat $ intersperse "\n"
-                   [show (rqMethod request)
-                   ,lookupHeader HdrContentMD5
-                   ,lookupHeader HdrContentType
-                   ,isoDate
-                   ,uriPath (rqURI request)]
-             authorization = Header HdrAuthorization $ "AWS " ++ akey ++ ":" ++ signature
-             signature = hmacSHA1 skey dat
-             lookupHeader hn = fromMaybe "" (findHeader hn request)
-             dateHdr = Header HdrDate isoDate
-             lengthHdr = Header HdrContentLength (show $ length (rqBody request))
-             connHdr = Header HdrConnection "Keep-Alive"
-             hostHdr = Header HdrHost (uriRegName auth)
-         return $ request
-                    { rqHeaders = hostHdr:connHdr:lengthHdr:dateHdr:
-                                  authorization:rqHeaders request
-                    , rqURI = (rqURI request) { uriScheme = ""
-                                              , uriAuthority = Nothing}}
-
-{- |
-  Return a connection to an S3 server. Will initiate a new
-  connection if no previous was found.
--}
-getConnection :: S3 -> IO Connection
-getConnection s3
-    = modifyMVar (s3Conn s3) $ \mbConn ->
-      case mbConn of
-        Just conn -> return (mbConn,conn)
-        Nothing -> do print (uriRegName auth, uriPort auth)
-                      c <- openTCPPort (uriRegName auth) (if null $ uriPort auth then 80 else read$ uriPort auth)
-                      return (Just c,c)
-    where auth = fromJust (uriAuthority (s3URI s3))
-
-createRequest :: S3 -> RequestMethod -> String -> String -> Request
-createRequest _s3 method path body
-    = Request uri method [] body
-    where uri = localhost { uriPath = '/':escapeURIString isAllowedInURI path }
-
-{- |
-  Send a single request to an S3 server returning the body
-  of the result.
--}
-sendRequest :: S3 -> Request -> IO String
-sendRequest s3 request
-    = loop =<< signRequest s3 request
-    where loop request'
-              = do c <- getConnection s3
-                   ret <- sendHTTP c request'
-                   case ret of
-                     Left ErrorClosed
-                         -> do putStrLn "Connection closed."
-                               swapMVar (s3Conn s3) Nothing
-                               loop request'
-                     Left err  -> error ("Failed to connect: " ++ show err) -- FIXME
-                     Right res
-                         | (2,_,_) <- rspCode res -> return (rspBody res)
-                         | otherwise -> error ("Server error: " ++ rspReason res)
-
-{- |
-  Same as 'sendRequest' except that it ignored the result.
--}
-sendRequest_ :: S3 -> Request -> IO ()
-sendRequest_ s3 request
-    = do sendRequest s3 request
-         return ()
-
-{-
-  Sign and send requests pipelined over a keep-alive connection.
--}
-{-
-  S3 imposes a quite severe limitation on pipelined requests.
-  Sending too many requests or exceeding a size limit will
-  result in a disconnect. The precise borders of these limits
-  are hard-wired and unknown to the general public. At the time
-  of this writing, sending three requests at a time seems optimal.
-
-  Quote from Amazons web-forum:
-  (http://developer.amazonwebservices.com/connect/thread.jspa?messageID=39883)
-  "OK, we have located the cause of the behavior you are seeing.
-   Your pipelined requests are being aborted because one of the
-   network devices handling the connection has certain limitations
-   on the amount of pipelined data it is willing to accept per
-   connection, and that limit is being exceeded. Unfortunately, this
-   limit is phrased in very low-level terms so it isn't possible to
-   say in a platform or network independent way whether any given
-   size, sequence or number of requests will exceed the limit and
-   cause a disconnection or not. We have engaged with the device
-   vendor and found out that this limit is hard-wired and that this
-   behavior is not likely to change any time soon.
-
-   In light of these facts, here is some guidance on pipelining HTTP
-   requests to Amazon S3.
-    1) Be optimistic and pipeline a modest number of GET or HEAD
-       requests, say two to four.
-    2) Handle asynchronous disconnects by re-connecting and re-sending
-       unacknowledged requests left in your pipeline. (As Colin points
-       out, correct HTTP clients must do this anyway)
-    3) If possible, try to minimize the number of TCP segments your
-       pipelined requests generate. In particular, leave the TCP socket
-       no delay option off and send as many requests per socket write call
-       as is practical."
--}
-
---------------------------------------------------------------
--- Initiate
---------------------------------------------------------------
-
-newS3 :: AccessKey -> SecretKey -> URI -> IO S3
-newS3 akey skey uri
-    = do conn <- newMVar Nothing
-         return $ S3 { s3AccessKey = akey
-                     , s3SecretKey = skey
-                     , s3URI       = uri
---                     , s3KeepAliveTimeout :: Int
-                     , s3Conn      = conn
-                     }
-
-closeS3 :: S3 -> IO ()
-closeS3 s3
-    = modifyMVar_ (s3Conn s3) $ \mbConn ->
-      case mbConn of
-        Nothing -> return Nothing
-        Just conn -> do Stream.close conn
-                        return Nothing
-
-
---------------------------------------------------------------
--- Requests
---------------------------------------------------------------
-
-
-createBucket :: S3 -> BucketId -> Request
-createBucket s3 bucket
-    = createRequest s3 PUT bucket ""
-
-createObject :: S3 -> BucketId -> ObjectId -> String -> Request
-createObject s3 bucket object
-    = createRequest s3 PUT (bucket ++ "/" ++ object)
-
-getObject :: S3 -> BucketId -> ObjectId -> Request
-getObject s3 bucket object
-    = createRequest s3 GET (bucket ++ "/" ++ object) ""
-
-deleteBucket :: S3 -> BucketId -> Request
-deleteBucket s3 bucket
-    = createRequest s3 DELETE bucket ""
-
-deleteObject :: S3 -> BucketId -> ObjectId -> Request
-deleteObject s3 bucket object
-    = createRequest s3 DELETE (bucket ++ "/" ++ object) ""
-
---------------------------------------------------------------
--- Actions
---------------------------------------------------------------
-
-
-listObjects :: S3 -> BucketId -> IO [String]
-listObjects s3 bucket
-    = do lst <- sendRequest s3 (createRequest s3 GET bucket "")
-         return $ ppContent . auxFilter . getContent . xmlParse bucket $ lst
-    where auxFilter = xtract "*/Key/-"
-          getContent (Document _ _ e _) = CElem e
-
-          ppContent xs  = [ s | CString _ s <- xs ]
-
-
-
-amazonURI :: URI
-amazonURI = fromJust $ parseURI "http://s3.amazonaws.com/"
-localhost :: URI
-localhost = fromJust $ parseURI "http://localhost/"
-
diff --git a/src/Happstack/Server/SimpleHTTP.hs b/src/Happstack/Server/SimpleHTTP.hs
--- a/src/Happstack/Server/SimpleHTTP.hs
+++ b/src/Happstack/Server/SimpleHTTP.hs
@@ -28,7 +28,7 @@
 -- like CGI\/FastCGI can used if so desired.
 --
 -- So the general nature of 'simpleHTTP' is no different than what you'd expect
--- from a web application container.  First you figure out when function is
+-- from a web application container.  First you figure out which function is
 -- going to process your request, process the request to generate a response,
 -- then return that response to the client. The web application container is
 -- started with 'simpleHTTP', which takes a configuration and a
@@ -108,6 +108,10 @@
     -- * SimpleHTTP
     , simpleHTTP
     , simpleHTTP'
+    , simpleHTTP''
+    , simpleHTTPWithSocket
+    , simpleHTTPWithSocket'
+    , bindPort
     , parseConfig
     -- * ServerPartT
     , ServerPartT(..)
@@ -162,10 +166,13 @@
     , addCookies
     , addHeaderM
     , setHeaderM
+    , ifModifiedSince
 
      -- * guards and building blocks
     , guardRq
     , dir
+    , host
+    , withHost
     , method
     , methodSP
     , methodM
@@ -174,6 +181,7 @@
     , path
     , anyPath
     , anyPath'
+    , trailingSlash
     , withData
     , withDataFn
     , getDataFn
@@ -224,11 +232,12 @@
 import Happstack.Server.HTTP.Client              (getResponse, unproxify, unrproxify)
 import Happstack.Data.Xml.HaXml                  (toHaXmlEl)
 import qualified Happstack.Server.MinHaXML       as H
-import qualified Happstack.Server.HTTP.Listen    as Listen (listen) -- So that we can disambiguate 'Writer.listen'
+import qualified Happstack.Server.HTTP.Listen    as Listen (listen, listen') -- So that we can disambiguate 'Writer.listen'
 import Happstack.Server.XSLT                     (XSLTCmd, XSLPath, procLBSIO)
 import Happstack.Server.SURI                     (ToSURI)
 import Happstack.Util.Common                     (Seconds, readM)
 import Happstack.Data                            (Xml, normalize, fromPairs, Element, toXml, toPublicXml) -- used by default implementation of fromData
+import Network                                   (listenOn, PortID(..), Socket)
 import Control.Applicative                       (Applicative, pure, (<*>))
 import Control.Concurrent                        (forkIO)
 import Control.Exception                         (evaluate)
@@ -252,6 +261,7 @@
 import Control.Monad.Error                       ( ErrorT(ErrorT), runErrorT
                                                  , Error, strMsg
                                                  , MonadError, throwError, catchError
+                                                 , mapErrorT
                                                  )
 import Control.Monad.Maybe                       (MaybeT(MaybeT), runMaybeT)
 import Data.Char                                 (ord)
@@ -280,7 +290,9 @@
                                                  , ArgOrder(Permute)
                                                  , getOpt
                                                  )
+import System.Locale                             (defaultTimeLocale)
 import System.Process                            (runInteractiveProcess, waitForProcess)
+import System.Time                               (CalendarTime, formatCalendarTime)
 import System.Exit                               (ExitCode(ExitSuccess, ExitFailure))
 
 -- | An alias for WebT when using IO
@@ -399,6 +411,10 @@
     askRq = ServerPartT $ ask
     localRq f m = ServerPartT $ local f (unServerPartT m)
 
+instance (Error e, ServerMonad m) => ServerMonad (ErrorT e m) where
+    askRq     = lift askRq
+    localRq f = mapErrorT $ localRq f
+
 -------------------------------
 -- HERE BEGINS WebT definitions
 
@@ -412,7 +428,7 @@
 -- @
 --
 -- A simple way of sumerizing this is, if the right side is Append, then the
--- right is appended to the left.  If the right side is Set, then the right side
+-- right is appended to the left.  If the right side is Set, then the left side
 -- is ignored.
 
 data SetAppend a = Set a | Append a
@@ -676,7 +692,7 @@
 simpleHTTP :: (ToMessage a) => Conf -> ServerPartT IO a -> IO ()
 simpleHTTP = simpleHTTP' id
 
--- | a combination of simpleHTTP and 'mapServerPartT'.  See 'mapServerPartT' for a discussion
+-- | a combination of simpleHTTP'' and 'mapServerPartT'.  See 'mapServerPartT' for a discussion
 -- of the first argument of this function.
 simpleHTTP' :: (ToMessage b, Monad m, Functor m) => (UnWebT m a -> UnWebT IO b)
             -> Conf -> ServerPartT m a -> IO ()
@@ -689,9 +705,36 @@
 simpleHTTP'' :: (ToMessage b, Monad m, Functor m) => ServerPartT m b -> Request -> m Response
 simpleHTTP'' hs req =  (runWebT $ runServerPartT hs req) >>= (return . (maybe standardNotFound id))
     where
-        standardNotFound = setHeader "Content-Type" "text/html" $ toResponse notFoundHtml
+        standardNotFound = setHeader "Content-Type" "text/html" $ (toResponse notFoundHtml){rsCode=404}
 
+-- | Run simpleHTTP with a previously bound socket. Useful if you want to run
+-- happstack as user on port 80. Use something like this:
+--
+-- > import System.Posix.User (setUserID, UserEntry(..), getUserEntryForName)
+-- >
+-- > main = do
+-- >     let conf = nullConf { port = 80 }
+-- >     socket <- bindPort conf
+-- >     -- do other stuff as root here
+-- >     getUserEntryForName "www" >>= setUserID . userID
+-- >     -- finally start handling incoming requests
+-- >     tid <- forkIO $ socketSimpleHTTP socket conf impl
+--
+-- Note: It's important to use the same conf (or at least the same port) for
+-- 'bindPort' and 'simpleHTTPWithSocket'.
+simpleHTTPWithSocket :: (ToMessage a) => Socket -> Conf -> ServerPartT IO a -> IO ()
+simpleHTTPWithSocket = simpleHTTPWithSocket' id
 
+-- | 'simpleHTTP'' with a socket
+simpleHTTPWithSocket' :: (ToMessage b, Monad m, Functor m) => (UnWebT m a -> UnWebT IO b)
+                      -> Socket -> Conf -> ServerPartT m a -> IO ()
+simpleHTTPWithSocket' toIO socket conf hs =
+    Listen.listen' socket conf (\req -> runValidator (fromMaybe return (validator conf)) =<< (simpleHTTP'' (mapServerPartT toIO hs) req))
+
+-- | Bind port and return the socket for 'simpleHTTPWithSocket'
+bindPort :: Conf -> IO Socket
+bindPort conf = listenOn (PortNumber . toEnum . port $ conf)
+
 -- | This class is used by 'path' to parse a path component into a value.
 -- At present, the instances for number types (Int, Float, etc) just
 -- call 'readM'. The instance for 'String' however, just passes the
@@ -870,6 +913,23 @@
             (p:xs) | p == staticPath -> localRq (\newRq -> newRq{rqPaths = xs}) handle
             _ -> mzero
 
+-- | Guard against the host
+host :: (ServerMonad m, MonadPlus m) => String -> m a -> m a
+host desiredHost handle =
+    do rq <- askRq
+       case getHeader "host" rq of
+         (Just hostBS) | desiredHost == B.unpack hostBS -> handle
+         _ -> mzero
+
+-- | Lookup the host header and pass it to the handler
+withHost :: (ServerMonad m, MonadPlus m) => (String -> m a) -> m a
+withHost handle =
+    do rq <- askRq
+       case getHeader "host" rq of
+         (Just hostBS) -> handle (B.unpack hostBS)
+         _ -> mzero
+
+
 -- | Pop a path element and parse it using the 'fromReqURI' in the 'FromReqURI' class.
 path :: (FromReqURI a, MonadPlus m, ServerMonad m) => (a -> m b) -> m b
 path handle = do
@@ -894,6 +954,11 @@
 anyPath' = anyPath
 {-# DEPRECATED anyPath' "Use anyPath" #-}
 
+-- | guard which checks that the Request URI ends in '\/'. 
+-- Useful for distinguishing between @foo@ and @foo/@
+trailingSlash :: (ServerMonad m, MonadPlus m) => m ()
+trailingSlash = guardRq $ \rq -> (last (rqUri rq)) == '/'
+
 -- | used to read parse your request with a RqData (a ReaderT, basically)
 -- For example here is a simple GET or POST variable based authentication
 -- guard.  It handles the request with errorHandler if authentication fails.
@@ -987,7 +1052,7 @@
 --
 -- TODO: this would be more useful if it didn\'t call "escape", just like
 -- proxyServe'
-rproxyServe :: (MonadIO m, WebMonad Response m) =>
+rproxyServe :: (MonadIO m) =>
     String -- ^ defaultHost
     -> [(String, String)] -- ^ map to look up hostname mappings.  For the reverse proxy
     -> ServerPartT m Response -- ^ the result is a ServerPartT that will reverse proxy for you.
@@ -1050,6 +1115,21 @@
 addCookies :: (FilterMonad Response m) => [(Seconds, Cookie)] -> m ()
 addCookies = mapM_ (uncurry addCookie)
 
+-- |honor if-modified-since header in Request
+-- If the 'Request' includes the if-modified-since header and the
+-- Response has not been modified, then return 304 (Not Modified),
+-- otherwise return the 'Response'.
+ifModifiedSince :: CalendarTime -- ^ mod-time for the Response (MUST NOT be later than server's time of message origination)
+                -> Request -- ^ incoming request (used to check for if-modified-since)
+                -> Response -- ^ Response to send if there are modifications
+                -> Response
+ifModifiedSince modTime request response =
+    let repr = formatCalendarTime defaultTimeLocale "%a, %d %b %Y %X GMT" modTime
+        notmodified = getHeader "if-modified-since" request == Just (B.pack $ repr)
+    in if notmodified
+          then result 304 "" -- Not Modified
+          else setHeader "Last-modified" repr response
+
 -- | same as setResponseCode status >> return val
 resp :: (FilterMonad Response m) => Int -> b -> m b
 resp status val = setResponseCode status >> return val
@@ -1144,10 +1224,9 @@
     parseHeader = break (':'==) . Base64.decode . B.unpack . B.drop 6
     headerName  = "WWW-Authenticate"
     headerValue = "Basic realm=\"" ++ realmName ++ "\""
-    err = do
-        unauthorized ()
-        setHeaderM headerName headerValue
-        escape' $ toResponse "Not authorized"
+    err = escape $ do
+            setHeaderM headerName headerValue
+            unauthorized $ toResponse "Not authorized"
 
 --------------------------------------------------------------
 -- Query/Post data validating
diff --git a/tests/Happstack/Server/Tests.hs b/tests/Happstack/Server/Tests.hs
--- a/tests/Happstack/Server/Tests.hs
+++ b/tests/Happstack/Server/Tests.hs
@@ -16,26 +16,34 @@
     "cookieParserTest" ~:
     [parseCookies "$Version=1;Cookie1=value1;$Path=\"/testpath\";$Domain=example.com;cookie2=value2"
         @?= (Right [
-            Cookie "1" "/testpath" "example.com" "cookie1" "value1"
-          , Cookie "1" "" "" "cookie2" "value2"
+            Cookie "1" "/testpath" "example.com" "cookie1" "value1" False
+          , Cookie "1" "" "" "cookie2" "value2" False
           ])
     ,parseCookies "  \t $Version = \"1\" ; cookie1 = \"randomcrap!@#%^&*()-_+={}[]:;'<>,.?/\\|\" , $Path=/  "
         @?= (Right [
-            Cookie "1" "/" "" "cookie1" "randomcrap!@#%^&*()-_+={}[]:;'<>,.?/\\|"
+            Cookie "1" "/" "" "cookie1" "randomcrap!@#%^&*()-_+={}[]:;'<>,.?/\\|" False
           ])
     ,parseCookies " cookie1 = value1  "
         @?= (Right [
-            Cookie "" "" "" "cookie1" "value1"
+            Cookie "" "" "" "cookie1" "value1" False
           ])
     ,parseCookies " $Version=\"1\";buggygooglecookie = valuewith=whereitshouldnotbe  "
         @?= (Right [
-            Cookie "1" "" "" "buggygooglecookie" "valuewith=whereitshouldnotbe"
+            Cookie "1" "" "" "buggygooglecookie" "valuewith=whereitshouldnotbe" False
           ])
     ]
 
 acceptEncodingParserTest :: Test
 acceptEncodingParserTest =
     "acceptEncodingParserTest" ~:
-    [either (Left . show) Right (parse encodings "" " gzip;q=1,*, compress ; q = 0.5 ")
-        @?= (Right [("gzip", Just 1),("*", Nothing),("compress", Just 0.5)])
-    ]
+    map (\(string, result) -> either (Left . show) Right (parse encodings "" string) @?= (Right result)) acceptEncodings
+    where
+      acceptEncodings =
+       [ (" gzip;q=1,*, compress ; q = 0.5 ", [("gzip", Just 1),("*", Nothing),("compress", Just 0.5)])
+       , (" compress , gzip", [ ("compress", Nothing), ("gzip", Nothing)])
+       , (" ", [])
+       , (" *", [("*", Nothing)])
+       , (" compress;q=0.5, gzip;q=1.0", [("compress", Just 0.5), ("gzip", Just 1.0)])
+       , (" gzip;q=1.0, identity; q=0.5, *;q=0", [("gzip", Just 1.0), ("identity",Just 0.5), ("*", Just 0)])
+       , (" x-gzip",[("x-gzip", Nothing)])
+       ]