diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) Adam Langley
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Network/MiniHTTP/Connection.hs b/Network/MiniHTTP/Connection.hs
new file mode 100644
--- /dev/null
+++ b/Network/MiniHTTP/Connection.hs
@@ -0,0 +1,120 @@
+module Network.MiniHTTP.Connection
+  ( Connection
+  , new
+  , forkThreads
+  , close
+  , connoutq
+  , connsocket
+  ) where
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Monad
+
+import Data.Maybe (fromJust)
+import qualified Data.ByteString as BS
+import qualified Data.Sequence as Seq
+
+import Network.Socket hiding (send, sendTo, recv, recvFrom)
+import Network.Socket.ByteString
+
+data Connection = Connection { connsocket :: Socket
+                             , connoutq :: TVar (Seq.Seq BS.ByteString)
+                             , connreaderthread :: TVar (Maybe ThreadId)
+                             , connwriterthread :: TVar (Maybe ThreadId)
+                             , conndeath :: IO ()
+                             , conndead :: TVar Bool }
+
+-- Threading: each connection has two threads: one pumping data out and one
+-- reading it in. The failure (by throwing an exception) of either is enough
+-- to close the socket and kill the connection. This could happen to both at
+-- the same time, in which case they race to set conndead to True.
+-- However, we also need to record their ThreadIds in the Connection record
+-- so that they can kill each other. It's possible that they could try to
+-- kill the connection right away - before the creating thread has recorded
+-- the correct ThreadIds in the Connection. Thus, at startup, they both wait
+-- for the controlling thread to set conndead to False before doing anything
+-- else
+
+new :: Socket  -- ^ the socket to make a connection from
+    -> IO ()  -- ^ the action run when the connection fails
+    -> STM Connection
+new socket deathaction = do
+  dead <- newTVar True
+  outq <- newTVar Seq.empty
+  p1 <- newTVar Nothing
+  p2 <- newTVar Nothing
+
+  let conn = Connection socket outq p1 p2 deathaction dead
+  return conn
+
+forkThreads :: Connection  -- ^ the connection to fork the threads for
+            -> IO ()  -- ^ the action which reads from the socket
+            -> IO ()
+forkThreads conn readeraction = do
+  reader <- forkIO $ waitForReadySignal conn $
+                     connectionThreadWrapper conn connwriterthread $
+                     readeraction
+  writer <- forkIO $ waitForReadySignal conn $
+                     connectionThreadWrapper conn connreaderthread $
+                     seqToSocket (connoutq conn) (connsocket conn)
+  -- update the thread ids in the Connection and set the ready flag
+  atomically (writeTVar (connreaderthread conn) (Just reader) >>
+              writeTVar (connwriterthread conn) (Just writer) >>
+              writeTVar (conndead conn) False)
+  return ()
+
+-- | Wait for conndead to be set to False on the given connection, then run
+--   the given action
+waitForReadySignal :: Connection -> IO a -> IO a
+waitForReadySignal conn action = do
+  atomically (do dead <- readTVar (conndead conn)
+                 if dead == True then retry else return ())
+  action
+
+-- | Wrap a connection thread so that, when the thread dies, it races to set
+--   the dead flag. If it does so, it closes the socket and kills the other
+--   thread
+connectionThreadWrapper :: Connection -> (Connection -> TVar (Maybe ThreadId)) -> IO a -> IO a
+connectionThreadWrapper conn otherthread action = do
+  finally action
+          (do isDead <- atomically (do dead <- readTVar (conndead conn)
+                                       when (not dead) $ writeTVar (conndead conn) True
+                                       return dead)
+              when (not isDead) (do t <- atomically (readTVar $ otherthread conn)
+                                    killThread $ fromJust t
+                                    sClose (connsocket conn)
+                                    conndeath conn))
+
+-- | Close a connection
+close :: Connection -> IO ()
+close = sClose . connsocket
+
+-- | Atomically take elements from the end of the given sequence and write them
+--   to the given socket. Throw an exception when the write fails
+seqToSocket :: TVar (Seq.Seq BS.ByteString)  -- ^ data is removed from the end
+            -> Socket  -- ^ the socket to write to
+            -> IO ()
+seqToSocket q sock = do
+  -- Atomically remove an element from the end of the sequence
+  bs <- atomically (do q' <- readTVar q
+                       (bs, rest) <-
+                         case Seq.viewr q' of
+                              Seq.EmptyR -> retry
+                              rest Seq.:> head -> return (head, rest)
+                       writeTVar q rest
+                       return bs)
+  -- Write the data to the socket
+  writea sock bs
+  seqToSocket q sock
+
+-- | Write a given number of bytes to a socket.
+writea :: Socket -> BS.ByteString -> IO ()
+writea sock bytes
+  | BS.null bytes = return ()
+  | otherwise = do
+    n <- send sock bytes
+    if n == BS.length bytes
+       then return ()
+       else writea sock $ BS.drop n bytes
diff --git a/Network/MiniHTTP/Marshal.hs b/Network/MiniHTTP/Marshal.hs
new file mode 100644
--- /dev/null
+++ b/Network/MiniHTTP/Marshal.hs
@@ -0,0 +1,735 @@
+{-# OPTIONS_GHC -fno-monomorphism-restriction
+                -fno-warn-missing-signatures #-}
+-- | This module serialises and deserialises HTTP headers. It contains Haskell
+--   representations of request and replies and can transform them to, and from,
+--   the HTTP wire format.
+module Network.MiniHTTP.Marshal
+  ( Request(..)
+  , Reply(..)
+  , Range(..)
+  , Headers(..)
+  , emptyHeaders
+  , statusToMessage
+  , Method(..)
+  , MediaType
+  , putRequest
+  , putReply
+  , parseRequest
+  , parseReply
+  ) where
+
+import Prelude hiding (putChar)
+import Control.Monad (when)
+import GHC.Exts()
+import Data.Time (UTCTime(..))
+import Data.Time.Format (formatTime)
+import Data.Time.Calendar (fromGregorian)
+import Data.Time.LocalTime (TimeOfDay(..), timeOfDayToTime)
+import Data.Int (Int64)
+import Data.Maybe (isJust, maybe)
+import Data.List (foldl')
+import System.Locale (TimeLocale(..))
+import qualified Data.Map as Map
+import Control.Applicative ((<|>), liftA, liftA2, (*>))
+import qualified Data.ByteString as B
+import Data.ByteString.Char8 ()
+import Data.ByteString.Internal (c2w, w2c)
+import qualified Data.Binary.Put as P
+import qualified Data.Binary.Strict.Get as G
+import qualified Data.Binary.Strict.Class as C
+import qualified Data.Binary.Strict.ByteSet as BSet
+
+import Debug.Trace (trace)
+
+debug x = trace (show x) x
+
+-- | A HTTP request
+data Request =
+  Request { reqMethod :: Method
+          , reqUrl :: B.ByteString
+          , reqMajor :: Int
+          , reqMinor :: Int
+          , reqHeaders :: Headers
+          } deriving (Show)
+
+-- | A HTTP reply
+data Reply =
+  Reply { replyMajor :: Int
+        , replyMinor :: Int
+        , replyStatus :: Int
+        , replyMessage :: String
+        , replyHeaders :: Headers
+        } deriving (Show)
+
+-- | A HTTP range
+data Range = RangeFrom Int64  -- ^ everything from the given byte onwards
+           | RangeOf Int64 Int64  -- ^ the bytes in the given range, inclusive
+           | RangeSuffix Int64  -- ^ the final n bytes
+           deriving (Show)
+
+-- | HTTP headers, see RFC 2616 section 14
+data Headers =
+  Headers { httpAccept :: Maybe [(MediaType, Int)]
+          , httpAcceptCharset :: Maybe [(String, Int)]
+          , httpAcceptEncoding :: Maybe [(String, Int)]
+          , httpAcceptLanguage :: Maybe [(String, Int)]
+          , httpAcceptRanges :: Bool
+          , httpAge :: Maybe Int64
+          , httpAllow :: Maybe [Method]
+          , httpAuthorization :: Maybe B.ByteString
+          , httpConnectionClose :: Bool
+          , httpConnection :: [String]
+          , httpContentEncodings :: [String]
+          , httpContentLanguage :: Maybe [String]
+          , httpContentLength :: Maybe Int64
+          , httpContentLocation :: Maybe B.ByteString
+          , httpContentRange :: Maybe (Maybe (Int64, Int64), Maybe Int64)
+          , httpContentType :: Maybe MediaType
+          , httpDate :: Maybe UTCTime
+          , httpETag :: Maybe (Bool, B.ByteString)
+          , httpExpires :: Maybe UTCTime
+          , httpHost :: Maybe B.ByteString
+          , httpIfMatch :: Maybe (Either () [B.ByteString])
+          , httpIfModifiedSince :: Maybe UTCTime
+          , httpIfNoneMatch :: Maybe (Either () [(Bool, B.ByteString)])
+          , httpIfRange :: Maybe (Either B.ByteString UTCTime)
+          , httpIfUnmodifiedSince :: Maybe UTCTime
+          , httpKeepAlive :: Maybe Int
+          , httpLastModified :: Maybe UTCTime
+          , httpLocation :: Maybe B.ByteString
+          , httpPragma :: Maybe [(String, Maybe String)]
+          , httpProxyAuthenticate :: Maybe B.ByteString
+          , httpProxyAuthorization :: Maybe B.ByteString
+          , httpRange :: Maybe [Range]
+          , httpReferer :: Maybe B.ByteString
+          , httpRetryAfter :: Maybe Int64
+          , httpServer :: Maybe B.ByteString
+          , httpTrailer :: Maybe [String]
+          , httpTransferEncoding :: [String]
+          , httpUserAgent :: Maybe B.ByteString
+          , httpWWWAuthenticate :: Maybe B.ByteString
+          , httpOtherHeaders :: Map.Map B.ByteString B.ByteString
+          } deriving (Show)
+
+emptyHeaders :: Headers
+emptyHeaders =
+  Headers Nothing Nothing Nothing Nothing
+  False Nothing Nothing Nothing False [] [] Nothing Nothing
+  Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+  Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+  Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+  Nothing [] Nothing Nothing Map.empty
+
+-- | The list of valid methods, see RFC 2616 section 5.1
+data Method = OPTIONS
+            | GET
+            | HEAD
+            | POST
+            | PUT
+            | DELETE
+            | TRACE
+            | CONNECT
+            deriving (Ord, Enum, Show, Eq)
+
+type MediaType = ((String, String), [(String, String)])
+
+-- | A mapping from status code to message. Taken from Johan Tibell's Hydra
+--   package
+reasonPhrases :: Map.Map Int String
+reasonPhrases = Map.fromList
+                [(100, "Continue")
+                ,(101, "Switching Protocols")
+                ,(200, "OK")
+                ,(201, "Created")
+                ,(202, "Accepted")
+                ,(203, "Non-Authoritative Information")
+                ,(204, "No Content")
+                ,(205, "Reset Content")
+                ,(206, "Partial Content")
+                ,(300, "Multiple Choices")
+                ,(301, "Moved Permanently")
+                ,(302, "Found")
+                ,(303, "See Other")
+                ,(304, "Not Modified")
+                ,(305, "Use Proxy")
+                ,(307, "Temporary Redirect")
+                ,(400, "Bad Request")
+                ,(401, "Unauthorized")
+                ,(402, "Payment Required")
+                ,(403, "Forbidden")
+                ,(404, "Not Found")
+                ,(405, "Method Not Allowed")
+                ,(406, "Not Acceptable")
+                ,(407, "Proxy Authentication Required")
+                ,(408, "Request Time-out")
+                ,(409, "Conflict")
+                ,(410, "Gone")
+                ,(411, "Length Required")
+                ,(412, "Precondition Failed")
+                ,(413, "Request Entity Too Large")
+                ,(414, "Request-URI Too Large")
+                ,(415, "Unsupported Media Type")
+                ,(416, "Requested range not satisfiable")
+                ,(417, "Expectation Failed")
+                ,(500, "Internal Server Error")
+                ,(501, "Not Implemented")
+                ,(502, "Bad Gateway")
+                ,(503, "Service Unavailable")
+                ,(504, "Gateway Time-out")
+                ,(505, "HTTP Version not supported")
+                ]
+
+-- | Convert a status code to a message (e.g. 200 -> "OK")
+statusToMessage :: Int -> String
+statusToMessage status = Map.findWithDefault "Unknown" status reasonPhrases
+
+--------------------------------------------------------------------------------
+-- These are the byte sets that we'll use for parsing.
+
+char = C.word8 . c2w
+urlSet = BSet.full `BSet.difference` (BSet.singleton 0x20)
+upAlphas = BSet.range (c2w 'A') (c2w 'Z')
+loAlphas = BSet.range (c2w 'a') (c2w 'z')
+alphas = upAlphas `BSet.union` loAlphas
+digits = BSet.range (c2w '0') (c2w '9')
+chars = BSet.range 0 127
+ctls = BSet.range 0 31 `BSet.union` BSet.singleton 127
+hs = BSet.fromList [32, 9]
+texts = (chars `BSet.difference` ctls) `BSet.union` hs
+hexes = BSet.range (c2w 'a') (c2w 'f') `BSet.union`
+        BSet.range (c2w 'A') (c2w 'F') `BSet.union`
+        digits
+separators = BSet.fromList $ map c2w "()<>@,;:\\\"/[]?={} \t"
+ctexts = texts `BSet.difference` (BSet.fromList $ map c2w "()\\")
+qdtexts = texts `BSet.difference` (BSet.fromList $ map c2w "\"\\")
+
+--------------------------------------------------------------------------------
+-- Parsing functions
+
+toString = map w2c . B.unpack
+
+lws = do
+  C.optional crlf
+  C.spanOf1 $ BSet.member hs
+
+token = C.spanOf1 $ BSet.member (texts `BSet.difference` (ctls `BSet.union` separators))
+qvalue = qOne <|> qFractional
+qOne = do
+  char '1'
+  (((char '.') >> C.many (char '0') >> return ()) <|> return ())
+  return 1000
+
+qFractional = do
+  char '0'
+  r <- (((char '.') >> C.spanOf (BSet.member digits)) <|> return "")
+  if B.null r
+     then return 0
+     else return $ read $ toString r ++ replicate (3 - B.length r) '0'
+
+comment = do
+  char '('
+  comment <- C.many ((C.spanOf $ BSet.member ctexts) <|> quotedPair <|> comment) >>= return . B.concat
+  char ')'
+  return comment
+
+quotedPair = (char '\\') >> (C.getWord8 >>= return . B.singleton)
+
+quotedString = do
+  char '"'
+  text <- C.many ((C.spanOf1 $ BSet.member qdtexts) <|> quotedPair) >>= return . B.concat
+  char '"'
+  return text
+
+-- | RFC 2616 2.1, #rule
+list p = do
+  let f = C.optional lws *> char ',' *> C.optional lws *> p
+  v <- p
+  rest <- C.many f
+  return $ v : rest
+
+crlf = C.word8 13 >> C.word8 10 >> return ()
+
+headerQualityTaggedList parseElement = do
+  let acceptParams = do
+        char ';'
+        C.optional lws
+        C.string "q="
+        q <- qvalue
+        C.many $ acceptExtension
+        return q
+      acceptExtension = do
+        char ';'
+        token
+        C.optional (char '=' >> (token <|> quotedString))
+      listElement = do
+        mr <- parseElement
+        params <- C.optional acceptParams
+        case params of
+             Nothing -> return (mr, 1000)
+             Just x -> return (mr, x)
+  list listElement
+
+stringToken = liftA toString token
+
+mediaType = liftA2 (,) ty params where
+  ty = liftA2 (,) stringToken (char '/' *> stringToken)
+  params = C.many (char ';' *> (liftA2 (,) notq (char '=' *> (stringToken <|> (liftA toString quotedString)))))
+  notq = do
+    s <- stringToken
+    if s == "q"
+       then fail ""
+       else return s
+
+-- | Parse an RFC1123 date
+date :: (C.BinaryParser m) => m UTCTime
+date = do
+  C.optional (token *> char ',' *> C.optional lws)
+  day <- int64
+  lws
+  monthstr <- token
+  lws
+  year <- int64
+  lws
+  hour <- int64
+  char ':'
+  min <- int64
+  char ':'
+  sec <- int64
+  lws
+  zone <- token
+
+  month <-
+    case monthstr of
+         "Jan" -> return 1
+         "Feb" -> return 2
+         "Mar" -> return 3
+         "Apr" -> return 4
+         "May" -> return 5
+         "Jun" -> return 6
+         "Jul" -> return 7
+         "Aug" -> return 8
+         "Sep" -> return 9
+         "Oct" -> return 10
+         "Nov" -> return 11
+         "Dec" -> return 12
+         _ -> fail ""
+
+
+  (hoffset, moffset) <-
+    case zone of
+         "UT" -> return (0, 0)
+         "UTC" -> return (0, 0)
+         "GMT" -> return (0, 0)
+         "EST" -> return (-5, 0)
+         "EDT" -> return (-4, 0)
+         "CST" -> return (-6, 0)
+         "CDT" -> return (-5, 0)
+         "MST" -> return (-7, 0)
+         "MDT" -> return (-6, 0)
+         "PST" -> return (-8, 0)
+         "PDT" -> return (-7, 0)
+         x -> return (sign * hours, sign * mins) where
+                (signchar:rest) = toString x
+                n = read rest
+                (hours, mins) = (n `div` 100, n `mod` 100)
+                sign = case signchar of
+                            '+' -> (-1)
+                            _ -> 1
+
+  let yday = fromGregorian (fromIntegral year) month (fromIntegral day)
+      time = timeOfDayToTime $ TimeOfDay (fromIntegral $ hour + hoffset) (fromIntegral $ min + moffset) (fromIntegral sec)
+      utc = UTCTime yday time
+
+  return utc
+
+-- | Parse a zero, or positive, int64
+int64 :: (C.BinaryParser c) => c Int64
+int64 = C.spanOf1 (BSet.member digits) >>= return . readOrZero . toString
+
+readOrZero "" = 0
+readOrZero x = read x
+
+--------------------------------------------------------------------------------
+-- Parsing functions for each header type
+
+headerAccept req = do
+  accepts <- headerQualityTaggedList mediaType
+  return $ req { httpAccept = Just accepts }
+
+headerAcceptCharset req = do
+  charsets <- headerQualityTaggedList (token >>= return . toString)
+  return $ req { httpAcceptCharset = Just charsets }
+
+headerAcceptEncoding req = do
+  encodings <- headerQualityTaggedList (token >>= return . toString)
+  return $ req { httpAcceptEncoding = Just encodings }
+
+headerAcceptLanguage req = do
+  langs <- headerQualityTaggedList (token >>= return . toString)
+  return $ req { httpAcceptLanguage = Just langs }
+
+headerAcceptRanges req = do
+  v <- C.optional $ C.string "bytes"
+  case v of
+       Nothing -> return req
+       Just _ -> return $ req { httpAcceptRanges = True }
+
+headerAge req = do
+  v <- int64
+  return $ req { httpAge = Just v }
+
+headerAllow req = do
+  methods <- list (C.spanOf (BSet.member upAlphas) >>= parseMethod)
+  return $ req { httpAllow = Just methods }
+
+headerAuth req = do
+  remaining <- C.remaining
+  d <- C.getByteString remaining
+  return $ req { httpAuthorization = Just d }
+
+headerConnection req = do
+  tokens <- list (token >>= return . toString)
+  return $ req { httpConnection = tokens,
+                 httpConnectionClose = "close" `elem` tokens }
+
+headerContentEncoding req = do
+  tokens <- list (token >>= return . toString)
+  return $ req { httpContentEncodings = tokens }
+
+headerContentLanguage req = do
+  tokens <- list (token >>= return . toString)
+  return $ req { httpContentLanguage = Just tokens }
+
+headerContentLength req = do
+  v <- int64
+  return $ req { httpContentLength = Just v }
+
+headerContentLocation req = do
+  remaining <- C.remaining
+  d <- C.getByteString remaining
+  return $ req { httpContentLocation = Just d }
+
+headerContentRange req = do
+  C.string "bytes "
+  a <- (char '*' *> return Nothing) <|> (liftA Just (liftA2 (,) int64 (char '-' *> int64)))
+  char '/'
+  b <- (char '*' *> return Nothing) <|> (liftA Just int64)
+  return $ req { httpContentRange = Just (a, b) }
+
+headerContentType req = do
+  ct <- mediaType
+  return $ req { httpContentType = Just ct }
+
+etag = do
+  weakness <- C.optional $ C.string "W/"
+  etag <- quotedString
+  return (isJust weakness, etag)
+
+headerETag req = do
+  etag >>= \tag -> return $ req { httpETag = Just tag }
+
+headerDate req = date >>= \date -> return $ req { httpDate = Just date }
+headerExpires req = date >>= \date -> return $ req { httpExpires = Just date }
+headerHost req = C.remaining >>= \rem -> C.getByteString rem >>= \x -> return $ req { httpHost = Just x }
+
+headerIfMatch req =
+  (char '*' *> return (Left ())) <|> (liftA Right $ list quotedString) >>=
+  \a -> return $ req { httpIfMatch = Just a }
+
+headerIfModifiedSince req = date >>= \date -> return $ req { httpIfModifiedSince = Just date }
+
+headerIfNoneMatch req =
+  (char '*' *> return (Left ())) <|> (liftA Right $ list etag) >>=
+  \a -> return $ req { httpIfNoneMatch = Just a }
+
+headerIfRange req = (liftA Left quotedString) <|> (liftA Right date) >>=
+  \a -> return $ req { httpIfRange = Just a }
+
+headerIfUnmodifiedSince req = date >>= \date -> return $ req { httpIfUnmodifiedSince = Just date }
+headerKeepAlive req = int64 >>= \v -> return $ req { httpKeepAlive = Just $ fromIntegral v }
+headerLastModified req = date >>= \date -> return $ req { httpLastModified = Just date }
+headerLocation req = C.remaining >>= \rem -> C.getByteString rem >>= \x -> return $ req { httpLocation = Just x }
+
+headerPragma req =
+  list (liftA2 (,) stringToken (C.optional $ char '=' *> (liftA toString (token <|> quotedString)))) >>=
+  \a -> return $ req { httpPragma = Just a }
+
+headerProxyAuthenticate req = C.remaining >>= \rem -> C.getByteString rem >>= \x -> return $ req { httpProxyAuthenticate = Just x }
+headerProxyAuthorization req = C.remaining >>= \rem -> C.getByteString rem >>= \x -> return $ req { httpProxyAuthorization = Just x }
+
+-- | Check that a list of ranges are syntatically valid
+checkRanges :: [Range] -> Maybe [Range]
+checkRanges ranges = r where
+  r = if any invalid ranges
+         then Nothing
+         else Just ranges
+  invalid (RangeOf a b) = a > b
+  invalid _ = False
+
+headerRange req = (C.string "bytes=" *> list f) >>= \a -> return $ req { httpRange = checkRanges $ debug a } where
+  f = a <|> b <|> c where
+    a = char '-' *> liftA RangeSuffix int64
+    b = int64 >>= (\start -> char '-' *> liftA (RangeOf start) int64)
+    c = int64 >>= (\start -> char '-' *> return (RangeFrom start))
+
+headerReferer req = C.remaining >>= \rem -> C.getByteString rem >>= \x -> return $ req { httpReferer = Just x }
+headerRetryAfter req = int64 >>= \i -> return $ req { httpRetryAfter = Just i }
+headerServer req = C.remaining >>= \rem -> C.getByteString rem >>= \x -> return $ req { httpServer = Just x }
+headerTransferEncoding req = list stringToken >>= \xs -> return $ req { httpTransferEncoding = xs }
+headerTrailer req = list stringToken >>= \xs -> return $ req { httpTrailer = Just xs }
+headerUserAgent req = C.remaining >>= \rem -> C.getByteString rem >>= \x -> return $ req { httpUserAgent = Just x }
+headerWWWAuthenticate req = C.remaining >>= \rem -> C.getByteString rem >>= \x -> return $ req { httpWWWAuthenticate = Just x }
+
+--------------------------------------------------------------------------------
+-- Top level parsing functions
+
+messageHeader = do
+  name <- token
+  char ':'
+  C.optional lws
+  value <- C.spanOf $ BSet.member texts
+  crlf
+
+  return (name, value)
+
+requestLine = do
+  method <- C.spanOf $ BSet.member upAlphas
+  C.word8 0x20
+  url <- C.spanOf $ BSet.member urlSet
+  C.word8 0x20
+  C.string "HTTP/"
+  major <- C.spanOf $ BSet.member digits
+  char '.'
+  minor <- C.spanOf $ BSet.member digits
+  crlf
+
+
+  return (method, url, (readOrZero $ toString major) :: Int
+                     , (readOrZero $ toString minor) :: Int)
+
+replyLine = do
+  C.string "HTTP/"
+  major <- C.spanOf $ BSet.member digits
+  char '.'
+  minor <- C.spanOf $ BSet.member digits
+  char ' '
+  status <- C.spanOf $ BSet.member digits
+  char ' '
+  message <- C.spanOf $ BSet.member texts
+  crlf
+
+  return (readOrZero $ toString major, readOrZero $ toString minor,
+          readOrZero $ toString status, toString message)
+
+headerParsers = Map.fromList
+  [ ("Accept", headerAccept)
+  , ("Accept-Charset", headerAcceptCharset)
+  , ("Accept-Encoding", headerAcceptEncoding)
+  , ("Accept-Language", headerAcceptLanguage)
+  , ("Accept-Ranges", headerAcceptRanges)
+  , ("Age", headerAge)
+  , ("Allow", headerAllow)
+  , ("Authorization", headerAuth)
+  , ("Connection", headerConnection )
+  , ("Content-Encoding", headerContentEncoding)
+  , ("Content-Language", headerContentLanguage)
+  , ("Content-Length", headerContentLength)
+  , ("Content-Location", headerContentLocation)
+  , ("Content-Range", headerContentRange)
+  , ("Content-Type", headerContentType)
+  , ("ETag", headerETag)
+  , ("Date", headerDate)
+  , ("Expires", headerExpires)
+  , ("Host", headerHost)
+  , ("If-Match", headerIfMatch)
+  , ("If-Modified-Since", headerIfModifiedSince)
+  , ("If-None-Match", headerIfNoneMatch)
+  , ("If-Range", headerIfRange)
+  , ("If-Unmodified-Since", headerIfUnmodifiedSince)
+  , ("Keep-Alive", headerKeepAlive)
+  , ("Last-Modified", headerLastModified)
+  , ("Location", headerLocation)
+  , ("Pragma", headerPragma)
+  , ("Proxy-Authenticate", headerProxyAuthenticate)
+  , ("Proxy-Authorization", headerProxyAuthorization)
+  , ("Range", headerRange)
+  , ("Referer", headerReferer)
+  , ("Retry-After", headerRetryAfter)
+  , ("Server", headerServer)
+  , ("Transfer-Encoding", headerTransferEncoding)
+  , ("Trailer", headerTrailer)
+  , ("User-Agent", headerUserAgent)
+  , ("WWW-Authenticate", headerWWWAuthenticate)
+  ]
+
+parseMethod :: (Monad m) => B.ByteString -> m Method
+parseMethod strmethod =
+  case strmethod of
+    "OPTIONS" -> return OPTIONS
+    "GET" -> return GET
+    "HEAD" -> return HEAD
+    "POST" -> return POST
+    "PUT" -> return PUT
+    "DELETE" -> return DELETE
+    "TRACE" -> return TRACE
+    "CONNECT" -> return CONNECT
+    _ -> fail "Bad method"
+
+parseRequest :: (C.BinaryParser m) => m Request
+parseRequest = do
+  (strmethod, url, major, minor) <- requestLine
+  method <- parseMethod strmethod
+  headers <- parseHeaders
+
+  return $ Request method url major minor headers
+
+parseReply :: (C.BinaryParser m) => m Reply
+parseReply = do
+  (major, minor, status, message) <- replyLine
+  headers <- parseHeaders
+
+  return $ Reply major minor status message headers
+
+parseHeaders = do
+  headers <- C.many $ messageHeader
+  crlf
+
+  let req = emptyHeaders
+      req' = foldl' tryHeader req headers
+      tryHeader req (header, value) =
+        case Map.lookup header headerParsers of
+             Nothing -> req { httpOtherHeaders = Map.insert header value $ httpOtherHeaders req }
+             Just p -> case G.runGet (p req) value of
+                            (Left _, _) -> req { httpOtherHeaders = Map.insert header value $ httpOtherHeaders req }
+                            (Right req', _) -> req'
+
+  return req'
+
+--------------------------------------------------------------------------------
+-- Serialisation functions
+
+putString = P.putByteString . B.pack . map c2w
+putChar = P.putWord8 . c2w
+
+putShow = putString . show
+
+putQualityList :: (a -> P.Put) -> [(a, Int)] -> P.Put
+putQualityList _ [] = return ()
+putQualityList f ((v, q):xs) = do
+  f v
+  when (q /= 1000) $ do
+    P.putByteString ";q=0."
+    putQuality q
+  putChar ','
+  putQualityList f xs
+
+putQuality x
+  | x `mod` 10 == 0 = putQuality $ div x 10
+  | otherwise = putString $ show x
+
+putHeaderM :: Maybe a -> B.ByteString -> (a -> P.Put) -> P.Put
+putHeaderM Nothing _ _ = return ()
+putHeaderM (Just x) h f = P.putByteString h >> P.putByteString ": " >> f x >> P.putByteString "\r\n"
+
+putHeaderML :: Maybe [a] -> B.ByteString -> (a -> P.Put) -> P.Put
+putHeaderML a b c = putHeaderM a b (mapM_ c)
+
+putHeaderL :: [a] -> B.ByteString -> (a -> P.Put) -> P.Put
+putHeaderL [] _ _ = return ()
+putHeaderL xs h f = P.putByteString h >> P.putByteString ": " >> mapM_ f xs >> P.putByteString "\r\n"
+
+putContentRange (Just (a, b), Just c) = putShow a >> putChar '-' >> putShow b >> putChar '/' >> putShow c
+putContentRange (Just (a, b), Nothing) = putShow a >> putChar '-' >> putShow b >> P.putByteString "/*"
+putContentRange (Nothing, Just c) = P.putByteString "*/" >> putShow c
+putContentRange (Nothing, Nothing) = P.putByteString "*/*"
+
+putList :: Char -> (a -> P.Put) -> [a] -> P.Put
+putList _ _ [] = return ()
+putList sep f (x:xs) = f x >> mapM_ (\x -> putChar sep >> f x) xs
+
+putMediaType ((ty, subty), opts) = do
+  putString ty
+  putChar '/'
+  putString subty
+
+  let f (a, b) = putChar ';' >> putString a >> putChar '=' >> putString b
+  mapM_ f opts
+
+putQuoted :: B.ByteString -> P.Put
+putQuoted s = putChar '"' >> f s >> putChar '"' where
+  f s
+    | B.null s = return ()
+    | otherwise = P.putByteString left >> f right where
+        (left, right) = B.span (/= (c2w) '"') s
+
+timeLocale = TimeLocale {wDays = [("Sunday","Sun"),("Monday","Mon"),("Tuesday","Tue"),("Wednesday","Wed"),("Thursday","Thu"),("Friday","Fri"),("Saturday","Sat")], months = [("January","Jan"),("February","Feb"),("March","Mar"),("April","Apr"),("May","May"),("June","Jun"),("July","Jul"),("August","Aug"),("September","Sep"),("October","Oct"),("November","Nov"),("December","Dec")], intervals = [("year","years"),("month","months"),("day","days"),("hour","hours"),("min","mins"),("sec","secs"),("usec","usecs")], amPm = ("AM","PM"), dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y", dateFmt = "%m/%d/%y", timeFmt = "%H:%M:%S", time12Fmt = "%I:%M:%S %p"}
+
+putDate = putString . formatTime timeLocale "%a, %d %b %Y %H:%M:%S GMT"
+putETag (weakness, tag) = (if weakness then P.putByteString "W/" else return ()) >> putQuoted tag
+putETagList = either (const $ putChar '*') $ putList ',' putQuoted
+putWETagList = either (const $ putChar '*') $ putList ',' putETag
+putPragma (key, mvalue) = putString key >> maybe (return ()) putString mvalue
+
+putRange (RangeOf a b) = putShow a >> putChar '-' >> putShow b
+putRange (RangeSuffix a) = putChar '-' >> putShow a
+putRange (RangeFrom a) = putShow a >> putChar '-'
+
+putHeaders :: Headers -> P.Put
+putHeaders headers = do
+  putHeaderM (httpAccept headers) "Accept" $ putQualityList putMediaType
+  putHeaderM (httpAcceptCharset headers) "Accept-Charset" $ putQualityList putString
+  putHeaderM (httpAcceptEncoding headers) "Accept-Encoding" $ putQualityList putString
+  putHeaderM (httpAcceptLanguage headers) "Accept-Language" $ putQualityList putString
+  when (httpAcceptRanges headers) $ P.putByteString "Accept-Ranges: bytes\r\n"
+  putHeaderM (httpAge headers) "Age" putShow
+  putHeaderML (httpAllow headers) "Allow" putShow
+  putHeaderM (httpAuthorization headers) "Authorization" P.putByteString
+  putHeaderL (httpConnection headers ++ if httpConnectionClose headers then ["close"] else [])
+             "Connection" putString
+  putHeaderL (httpContentEncodings headers) "Content-Encoding" putString
+  putHeaderML (httpContentLanguage headers) "Content-Language" putString
+  putHeaderM (httpContentLength headers) "Content-Length" putShow
+  putHeaderM (httpContentLocation headers) "Content-Location" P.putByteString
+  putHeaderM (httpContentRange headers) "Content-Range" putContentRange
+  putHeaderM (httpContentType headers) "Content-Type" putMediaType
+  putHeaderM (httpDate headers) "Date" putDate
+  putHeaderM (httpETag headers) "ETag" putETag
+  putHeaderM (httpExpires headers) "Expires" putDate
+  putHeaderM (httpHost headers) "Host" P.putByteString
+  putHeaderM (httpIfMatch headers) "If-Match" putETagList
+  putHeaderM (httpIfModifiedSince headers) "If-Modified-Since" putDate
+  putHeaderM (httpIfNoneMatch headers) "If-None-Match" putWETagList
+  putHeaderM (httpIfRange headers) "If-Range" $ either putQuoted putDate
+  putHeaderM (httpIfUnmodifiedSince headers) "If-Unmodified-Since" putDate
+  putHeaderM (httpKeepAlive headers) "Keep-Alive" putShow
+  putHeaderM (httpLastModified headers) "Last-Modified" putDate
+  putHeaderM (httpLocation headers) "Location" P.putByteString
+  putHeaderML (httpPragma headers) "Pragma" putPragma
+  putHeaderM (httpProxyAuthenticate headers) "Proxy-Authenticate" P.putByteString
+  putHeaderM (httpProxyAuthorization headers) "Proxy-Authorization" P.putByteString
+  putHeaderML (httpRange headers) "Range" putRange
+  putHeaderM (httpReferer headers) "Referer" P.putByteString
+  putHeaderM (httpRetryAfter headers) "Retry-After" putShow
+  putHeaderM (httpServer headers) "Server" P.putByteString
+  putHeaderL (httpTransferEncoding headers) "Transfer-Encoding" putString
+  putHeaderML (httpTrailer headers) "Trailer" putString
+  putHeaderM (httpUserAgent headers) "User-Agent" P.putByteString
+  putHeaderM (httpWWWAuthenticate headers) "WWW-Authenticate" P.putByteString
+  mapM_ (\(k, v) -> P.putByteString k >> putString ": " >> P.putByteString v) $
+         Map.toList $ httpOtherHeaders headers
+
+putRequest :: Request -> P.Put
+putRequest (Request method url major minor headers) = do
+  putShow method >> putChar ' ' >> P.putByteString url >> putChar ' '
+  P.putByteString "HTTP/"
+  putShow major >> putChar '.' >> putShow minor >> P.putByteString "\r\n"
+  putHeaders headers
+  P.putByteString "\r\n"
+
+putReply :: Reply -> P.Put
+putReply (Reply major minor status message headers) = do
+  P.putByteString "HTTP/" >> putShow major >> putChar '.' >> putShow minor
+  putChar ' ' >> putShow status >> putChar ' '
+  putString message >> P.putByteString "\r\n"
+  putHeaders headers
+  P.putByteString "\r\n"
diff --git a/Network/MiniHTTP/MimeTypesParse.hs b/Network/MiniHTTP/MimeTypesParse.hs
new file mode 100644
--- /dev/null
+++ b/Network/MiniHTTP/MimeTypesParse.hs
@@ -0,0 +1,61 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+-- | This module parses the /etc/mime.types file, commonly found on UNIX
+--   systems. This file provides a mapping from file extension to
+--   MIME type.
+module Network.MiniHTTP.MimeTypesParse
+  ( parseMimeTypes
+  , parseMimeTypesTotal
+  ) where
+
+import Prelude hiding (catch)
+import Control.Applicative
+import Control.Exception (catch)
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes)
+import qualified Data.ByteString as B
+import Data.ByteString.Internal (w2c)
+import qualified Data.Binary.Strict.Get as G
+import qualified Data.Binary.Strict.Class as C
+import qualified Data.Binary.Strict.ByteSet as BSet
+
+import Network.MiniHTTP.Marshal (MediaType)
+
+lws = BSet.fromList [9, 32]
+newline = BSet.singleton 10
+notNewline = BSet.complement newline
+others = BSet.complement (lws `BSet.union` newline)
+otherNotSlash = others `BSet.difference` BSet.singleton 47
+
+line = do
+  ty <- C.spanOf1 $ BSet.member otherNotSlash
+  C.word8 47
+  subty <- C.spanOf1 $ BSet.member otherNotSlash
+  C.spanOf1 $ BSet.member lws
+  ext <- C.spanOf1 $ BSet.member others
+  exts <- C.many $ C.spanOf (BSet.member lws) >> C.spanOf1 (BSet.member others)
+  optional (C.spanOf (BSet.member lws) >> C.word8 35 >> C.spanOf (BSet.member notNewline))
+  C.word8 10
+  return $ Just ((ty, subty), ext : exts)
+
+blankLine = C.spanOf (BSet.member lws) >> C.optional (C.word8 35 >> C.spanOf (BSet.member notNewline)) >> C.word8 10 >> return Nothing
+
+file = C.many (blankLine <|> line <|> (C.spanOf (BSet.member notNewline) >> C.word8 10 >> return Nothing))
+
+toMap ents = Map.fromList elems where
+  ents' = catMaybes ents
+  elems = concatMap (\((ty, subty), exts) -> zip exts $ repeat ((toString ty, toString subty), [])) ents'
+  toString = map w2c . B.unpack
+
+-- | Parse the given filename as a mime.types file and return a map from file
+--   extension to mime type.
+parseMimeTypes :: String -> IO (Map.Map B.ByteString MediaType)
+parseMimeTypes filename = do
+  contents <- B.readFile filename
+  case G.runGet file contents of
+       (Right results, _) -> return $ toMap results
+       (Left err, _) -> fail err
+
+-- | Same as @parseMimeTypes@, but never throw an exception, return a Nothing
+--   instead.
+parseMimeTypesTotal :: String -> IO (Maybe (Map.Map B.ByteString MediaType))
+parseMimeTypesTotal filename = catch (parseMimeTypes filename >>= return . Just) (const $ return Nothing)
diff --git a/Network/MiniHTTP/Server.hs b/Network/MiniHTTP/Server.hs
new file mode 100644
--- /dev/null
+++ b/Network/MiniHTTP/Server.hs
@@ -0,0 +1,429 @@
+-- | This module contains functions for writing webservers. These servers
+--   process requests in a state monad pipeline and several useful actions are
+--   provided here in. See examples/fileserver.hs for an example of how to use
+--   this module.
+module Network.MiniHTTP.Server
+  ( -- * Sources
+    Source
+  , SourceResult(..)
+  , bsSource
+  , hSource
+  , nullSource
+
+  -- * The processing monad
+  , WebMonad
+  , WebState
+  , getRequest
+  , getReply
+  , setReply
+  , setHeader
+
+  -- * WebMonad actions
+  , handleConditionalRequest
+  , handleHandleToSource
+  , handleRangeRequests
+  , handleDecoration
+  , handleFromFilesystem
+
+  -- * Running the server
+  , serve
+  ) where
+
+import Prelude hiding (foldl, elem, catch)
+
+import Control.Concurrent.STM
+import Control.Monad (liftM)
+import Control.Monad.State.Strict
+import Control.Exception (catch)
+
+import Data.Foldable
+import Data.Word (Word16)
+import Data.Bits (shiftL, shiftR, (.|.), (.&.))
+import Data.Maybe (isNothing, isJust, fromJust, catMaybes, maybe)
+import Data.Time.Clock.POSIX
+import Data.IORef
+import Data.Int (Int64)
+import qualified Data.ByteString as B
+import Data.ByteString.Internal (w2c, c2w)
+import Data.ByteString.Char8 ()
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Map as Map
+import qualified Data.Sequence as Seq
+import System.IO
+import System.Posix
+import System.FilePath (combine, splitDirectories, joinPath, takeExtension)
+import Network.Socket hiding (send, sendTo, recv, recvFrom)
+import Network.Socket.ByteString
+import Text.Printf (printf)
+
+import qualified Data.Binary.Put as P
+import qualified Data.Binary.Strict.IncrementalGet as IG
+import Network.MiniHTTP.Marshal
+import qualified Network.MiniHTTP.Connection as C
+import Network.MiniHTTP.MimeTypesParse
+
+-- | This assumes a little endian system because I can't find a nice way to probe
+--   the endianness
+htons :: Word16 -> Word16
+htons x = ((x .&. 255) `shiftL` 8) .|. (x `shiftR` 8)
+
+-- | A source is a stream of data, like a lazy data structure, but without
+--   some of the dangers that such entail. A source returns a @SourceResult@
+--   each time you evaluate it.
+type Source = IO SourceResult
+
+data SourceResult = SourceError  -- ^ error - please don't read this source again
+                  | SourceEOF  -- ^ end of data
+                  | SourceData B.ByteString  -- ^ some data
+                  deriving (Show)
+
+-- | Construct a source from a ByteString
+bsSource :: B.ByteString -> IO Source
+bsSource bs = do
+  ref <- newIORef $ SourceData bs
+  return $ do
+    v <- readIORef ref
+    writeIORef ref SourceEOF
+    return v
+
+-- | Construct a source from a Handle
+hSource :: (Int64, Int64)  -- ^ the first and last byte to include
+               -> Handle  -- ^ the handle to read from
+               -> IO Source
+hSource (from, to) handle = do
+  bytesSoFar <- newIORef (from :: Int64)
+  hSeek handle AbsoluteSeek (fromIntegral from)
+  return $ do
+    catch
+      (do done <- readIORef bytesSoFar
+          bytes <- B.hGet handle $ min (128 * 1024) (fromIntegral $ (to + 1) - done)
+          if B.length bytes == 0
+             then do
+               if to + 1 == done
+                  then return SourceEOF
+                  else return SourceError
+             else do modifyIORef bytesSoFar ((+) (fromIntegral $ B.length bytes))
+                     return $ SourceData bytes)
+      (const $ return SourceError)
+
+-- | A source with no data (e.g. /dev/null)
+nullSource :: Source
+nullSource = return SourceEOF
+
+-- | Processing a request involve running a number of actions in a StateT monad
+--   where the state for that monad is this record. This contains both a
+--   @Source@ and a @Handle@ element. Often something will fill in the @Handle@
+--   and expect later processing to convert it to a @Source@. Somehow, you have
+--   to end up with a @Source@, however.
+data WebState =
+  WebState { wsRequest :: Request  -- ^ the original request
+             -- | the system mime types db, mapping file extensions
+           , wsMimeTypes :: Map.Map B.ByteString MediaType
+           , wsReply :: Reply   -- ^ the current reply
+           , wsSource :: Maybe Source  -- ^ the current source
+           , wsHandle :: Maybe Handle  -- ^ the current handle
+             -- | an action to be performed before sending the reply
+           , wsAction :: Maybe (IO ())
+           }
+
+-- | The processing monad
+type WebMonad = StateT WebState IO
+
+-- | Return the request
+getRequest :: WebMonad Request
+getRequest = get >>= return . wsRequest
+
+-- | Return the current reply
+getReply :: WebMonad Reply
+getReply = get >>= return . wsReply
+
+-- | Set the current reply to be a reply with the given status code, the
+--   default message for that status code, an empty body and an empty set of
+--   headers.
+setReply :: Int -> WebMonad ()
+setReply code = do
+  s <- get
+  put $ s { wsAction = Nothing, wsSource = Nothing, wsHandle = Nothing,
+            wsReply = Reply 1 1 code (statusToMessage code) $
+              emptyHeaders {httpContentLength = Just 0} }
+
+-- | Set a header in the current reply. Because of the way records work, you use
+--   this function like this:
+--
+--   > setHeader $ \h -> h { httpSomeHeader = Just value }
+setHeader :: (Headers -> Headers) -> WebMonad ()
+setHeader f = do
+  reply <- getReply
+  let h = replyHeaders reply
+  s <- get
+  put $ s { wsReply = reply { replyHeaders = f h } }
+
+
+-- | This handles the If-*Matches and If-*Modified conditional headers. It takes
+--   its information from the Last-Modified and ETag headers of the current
+--   reply. Note that, for the purposes of ETag matching, a reply without
+--   an ETag header is considered not to exist from the point of view of,
+--   say, If-Matches: *.
+handleConditionalRequest :: WebMonad ()
+handleConditionalRequest = do
+  req <- getRequest
+  reply <- getReply
+  let metag = httpETag $ replyHeaders reply
+      mmtime = httpLastModified $ replyHeaders reply
+
+  case httpIfMatch $ reqHeaders req of
+       Just (Left ()) -> when (isNothing $ metag) $ setReply 412
+       Just (Right tags) ->
+         case metag of
+              Nothing -> setReply 412
+              Just (False, etag) -> when (not $ elem etag tags) $ setReply 412
+              Just (True, _) -> setReply 412
+       Nothing -> return ()
+
+  case httpIfNoneMatch $ reqHeaders req of
+       Just (Left ()) -> when (isJust $ metag) $ setReply 412
+       Just (Right tags) ->
+         case metag of
+              Nothing -> return ()
+              Just tag -> when (elem tag tags) $ setReply 412
+       Nothing -> return ()
+
+  case httpIfModifiedSince $ reqHeaders req of
+       Just rmtime -> case mmtime of
+                           Just mtime -> when (mtime <= rmtime) $ setReply 304
+                           Nothing -> return ()
+       Nothing -> return ()
+
+  case httpIfUnmodifiedSince $ reqHeaders req of
+       Just rmtime -> case mmtime of
+                           Just mtime -> when (rmtime <= mtime) $ setReply 412
+                           Nothing -> return ()
+       Nothing -> return ()
+
+-- | If the current state includes a Handle, this turns it into a Source
+handleHandleToSource :: WebMonad ()
+handleHandleToSource = do
+  reply <- getReply
+  mhandle <- liftM wsHandle get
+  case mhandle of
+       Just handle -> do
+         source <- lift $ hSource (0, (fromJust $ httpContentLength $ replyHeaders reply) - 1) handle
+         get >>= \s -> put $ s { wsHandle = Nothing, wsSource = Just source }
+       Nothing -> return ()
+
+-- | Given the length of the resource, filter any unsatisfiable ranges and
+--   convert them all into RangeOf form.
+satisfiableRanges :: Int64 -> [Range] -> [Range]
+satisfiableRanges contentLength = catMaybes . map f where
+  f (RangeFrom a)
+    | a < contentLength = Just $ RangeOf a $ contentLength - 1
+    | otherwise = Nothing
+  f (RangeOf a b)
+    | a < contentLength = Just $ RangeOf a $ min b contentLength
+    | otherwise = Nothing
+  f (RangeSuffix a)
+    | a > 0 && contentLength > 0 = Just $ RangeOf (contentLength - a) (contentLength - 1)
+    | otherwise = Nothing
+
+-- | This handles Range requests and also translates from Handles to Sources.
+--   If the WebMonad has a Handle at this point, then we can construct sources
+--   from any subrange of the file. (We also assume that Content-Length is
+--   correctly set.)
+--
+--   See RFC 2616, section 14.35
+handleRangeRequests :: WebMonad ()
+handleRangeRequests = do
+  mhandle <- get >>= return . wsHandle
+  req <- getRequest
+  reply <- getReply
+  case mhandle of
+       Nothing -> return ()
+       Just handle ->
+         case httpContentLength $ replyHeaders reply of
+              Nothing -> handleHandleToSource
+              Just contentLength -> do
+                setHeader (\h -> h { httpAcceptRanges = True })
+                case httpRange $ reqHeaders req of
+                     Nothing -> handleHandleToSource
+                     Just ranges -> do
+                       let ranges' = satisfiableRanges contentLength ranges
+                       case ranges' of
+                          [] -> do
+                            setReply 416
+                            setHeader (\h -> h { httpContentRange = Just (Nothing, Just contentLength) })
+                          [RangeOf a b] -> do
+                            s <- get
+                            source <- lift $ hSource (a, b) handle
+                            put $ s { wsReply = (wsReply s) { replyStatus = 206
+                                                            , replyMessage = "Partial Content" }
+                                    , wsHandle = Nothing
+                                    , wsSource = Just source }
+                            setHeader (\h -> h { httpContentRange = Just (Just (a, b), Just contentLength)})
+                            setHeader (\h -> h { httpContentLength = Just ((b - a) + 1)})
+                          -- We don't support multiple ranges
+                          _ -> return ()
+
+-- | At the moment, this just adds the header Server: Network.MiniHTTP
+handleDecoration :: WebMonad ()
+handleDecoration = setHeader (\h -> h { httpServer = Just "Network.MiniHTTP" })
+
+-- | If a source is missing, install a null source. If this was a HEAD request,
+--   remove the current source and set the content length to 0
+handleFinal :: StateT WebState IO ()
+handleFinal = do
+  s <- get
+  case wsSource s of
+       Nothing -> do setHeader (\h -> h { httpContentLength = Just 0 })
+                     s <- get
+                     put $ s { wsSource = Just nullSource }
+       _ -> return ()
+
+  s <- get
+  req <- getRequest
+  if reqMethod req == HEAD
+     then do
+       setHeader $ \h -> h { httpContentLength = Just 0
+                           , httpTransferEncoding = [] }
+       put $ s { wsSource = Just nullSource }
+     else return ()
+
+-- | This is a very simple handler which deals with requests by returning the
+--   requested file from the filesystem. It sets a Handle in the state and sets
+--   the Content-Type, Content-Length and Last-Modified headers
+handleFromFilesystem :: FilePath -- ^ the root of the filesystem to serve from
+                     -> WebMonad ()
+handleFromFilesystem docroot = do
+  req <- getRequest
+  when (not $ reqMethod req `elem` [GET, HEAD]) $
+    fail "Can only handle GET and HEAD from the filesystem"
+
+  -- stopping directory traversal needs to be done a little carefully.
+  -- Hopefully this is all correct
+  let path = reqUrl req
+      -- First, make sure that there aren't any NULs in the path
+      path' = B.takeWhile (/= 0) path
+      path'' = map w2c $ B.unpack path'
+      elems = splitDirectories path''
+      -- Remove any '..'
+      elems' = filter (\x -> x /= ".." && x /= "/") elems
+      ext = takeExtension path''
+      filepath = combine docroot $ joinPath elems'
+  mimeTypes <- get >>= return . wsMimeTypes
+  s <- get
+  s' <- lift $ catch
+    (do fd <- openFd filepath ReadOnly Nothing (OpenFileFlags False False True False False)
+        stat <- getFdStatus fd
+        let size = fromIntegral $ fileSize stat
+            mtime = posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
+        handle <- fdToHandle fd
+        return $ s { wsHandle = Just handle
+                   , wsSource = Nothing
+                   , wsReply = Reply 1 1 200 "Ok" $ emptyHeaders
+                      { httpLastModified = Just mtime
+                      , httpContentLength = Just size
+                      , httpContentType = Map.lookup (B.pack $ map c2w ext) mimeTypes } } )
+    (const $ return $ s { wsReply = Reply 1 1 404 "Not found" $ emptyHeaders })
+  put s'
+
+pipeline :: Map.Map B.ByteString MediaType
+         -> WebMonad ()
+         -> Request
+         -> IO (Reply, Source)
+pipeline mimetypes action req = do
+  let initState = (WebState req mimetypes (Reply 1 1 500 "Server error" emptyHeaders)
+                   Nothing Nothing Nothing)
+  (_, s) <- runStateT (do
+    action
+    handleFinal) initState
+
+  return (wsReply s, fromJust $ wsSource s)
+
+-- | Block until the given queue has less than the given number of bytes in it
+--   then enqueue a new ByteString.
+waitForLowWaterAndEnqueue :: Int  -- ^ the max number of bytes in the queue before we enqueue anything
+                          -> C.Connection  -- ^ the connection to write to
+                          -> B.ByteString  -- ^ the data to enqueue
+                          -> IO ()
+waitForLowWaterAndEnqueue lw conn bs = do
+  atomically $ do
+    q <- readTVar $ C.connoutq conn
+    let size = foldl (\sz bs -> sz + B.length bs) 0 q
+    if size > lw
+       then retry
+       else writeTVar (C.connoutq conn) $ bs Seq.<| q
+
+-- | Read a single request from a socket
+readRequest :: Socket
+            -> B.ByteString  -- ^ data which has already been read from the socket
+            -> IO (B.ByteString, Request)
+readRequest socket initbs = do
+  let f result = do
+        case result of
+             IG.Failed _ -> fail "Parse failed"
+             IG.Partial cont -> recv socket 256 >>= (\x -> (f $ cont x))
+             IG.Finished rest result -> return (rest, result)
+  f $ IG.runGet parseRequest initbs
+
+-- | Loop, reading and processing requests
+readRequests :: (Request -> IO (Reply, IO SourceResult))
+             -> C.Connection
+             -> B.ByteString  -- ^ previously read data
+             -> IO ()
+readRequests handler conn initbs = do
+  (rest, result) <- readRequest (C.connsocket conn) initbs
+  (reply, source) <- handler result
+  let lowWater = 32 * 1024
+      stream = do
+        next <- source
+        case next of
+             SourceEOF -> return True
+             SourceError -> return False
+             SourceData bs -> waitForLowWaterAndEnqueue lowWater conn bs >> stream
+      streamChunked = do
+        next <- source
+        case next of
+             SourceEOF -> do
+               waitForLowWaterAndEnqueue lowWater conn "0\r\n\r\n"
+               return True
+             SourceError -> return False
+             SourceData bs -> do
+               waitForLowWaterAndEnqueue lowWater conn $ B.pack $ map c2w $
+                 printf "%d\r\n\r\n" $ B.length bs
+               waitForLowWaterAndEnqueue lowWater conn bs
+               waitForLowWaterAndEnqueue lowWater conn "\r\n"
+               streamChunked
+  waitForLowWaterAndEnqueue (32 * 1024) conn $ B.concat $ BL.toChunks $ P.runPut $ putReply reply
+  success <- if isNothing $ httpContentLength $ replyHeaders reply
+                then streamChunked
+                else stream
+  if not success
+     then C.close conn
+     else readRequests handler conn rest
+
+acceptLoop :: Socket -> (Request -> IO (Reply, Source)) -> IO ()
+acceptLoop acceptingSocket handler = do
+  (newsock, addr) <- accept acceptingSocket
+  setSocketOption newsock NoDelay 1
+  putStrLn $ "Connection from " ++ show addr
+
+  c <- atomically $ C.new newsock (return ())
+  C.forkThreads c $ readRequests handler c B.empty
+  acceptLoop acceptingSocket handler
+
+serve :: Int  -- ^ the port number to listen on
+      -> WebMonad ()  -- ^ the processing action
+      -> IO ()
+serve portno action = do
+  -- Switch these two lines to use IPv6 (which works for IPv4 clients too)
+  --acceptingSocket <- socket AF_INET6 Stream 0
+  --let sockaddr = SockAddrInet6 (PortNum $ htons $ fromIntegral portno) 0 iN6ADDR_ANY 0
+
+  acceptingSocket <- socket AF_INET Stream 0
+  let sockaddr = SockAddrInet (PortNum $ htons $ fromIntegral portno) iNADDR_ANY
+  setSocketOption acceptingSocket ReuseAddr 1
+  bindSocket acceptingSocket sockaddr
+  listen acceptingSocket 1
+  mimetypes <- parseMimeTypesTotal "/etc/mime.types" >>= return . maybe Map.empty id
+
+  catch (acceptLoop acceptingSocket $ pipeline mimetypes action)
+        (const $ sClose acceptingSocket)
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/examples/fileserver.hs b/examples/fileserver.hs
new file mode 100644
--- /dev/null
+++ b/examples/fileserver.hs
@@ -0,0 +1,20 @@
+-- | This is a very simple fileserver HTTP server which serves from the current
+--   directory. It will handle If-Modified-Since and Range requests etc. It
+--   doesn't do directory indexes yet, so GETting '/' will give a 404
+module Main where
+
+import Network.MiniHTTP.Server
+
+main = serve 4112 $ do
+  handleFromFilesystem "."
+  handleConditionalRequest
+  handleRangeRequests
+  handleDecoration
+
+-- If you wanted to process some URLs differently, you would do something like:
+--   req <- getRequest
+--   if iWantToHandle $ reqUrl req
+--      then xyx
+--      else handleFromFilesystem "."
+--   handleConditionalRequest
+--   ...
diff --git a/network-minihttp.cabal b/network-minihttp.cabal
new file mode 100644
--- /dev/null
+++ b/network-minihttp.cabal
@@ -0,0 +1,18 @@
+name:            network-minihttp
+version:         0.1
+license:         BSD3
+license-file:    LICENSE
+author:          Adam Langley <agl@imperialviolet.org>
+description:     A very minimal webserver
+synopsis:        A very minimal webserver
+category:        Network
+build-depends:   base, containers, bytestring>=0.9, network-bytestring>=0.1.1.2, network>=2.1, stm>=2.1, binary>=0.4, binary-strict>=0.3, filepath>=1.1.0.0, mtl>=1.1.0.0, unix>=2.3.0.0, time>=1.1.2.0, old-locale>=1.0.0.0
+stability:       provisional
+tested-with:     GHC == 6.8.2
+exposed-modules: Network.MiniHTTP.Server,
+                 Network.MiniHTTP.Marshal
+                 Network.MiniHTTP.MimeTypesParse
+other-modules:   Network.MiniHTTP.Connection
+extra-source-files: examples/fileserver.hs
+ghc-options:     -Wall -fno-warn-name-shadowing
+extensions:      OverloadedStrings