diff --git a/Network/HTTP.hs b/Network/HTTP.hs
--- a/Network/HTTP.hs
+++ b/Network/HTTP.hs
@@ -216,6 +216,7 @@
   | ResponseContentBufferedIdentity
   | ResponseContentUnbufferedIdentity Int
   | ResponseContentChunked
+  deriving (Show)
 
 
 -- | An object representing a cookie (a small piece of information, mostly
@@ -290,18 +291,17 @@
   state <- getHTTPState
   let mvar = httpStateThreadSetMVar state
       msem = httpStateThreadTerminationMSem state
-  threadSet <- takeMVar mvar
-  childThread <- liftBaseDiscard (httpStateForkPrimitive state)
-    $ finally action
-              (do
-                threadSet <- takeMVar mvar
-                self <- myThreadId
-                let threadSet' = Set.delete self threadSet'
-                putMVar mvar threadSet'
-                liftBase $ MSem.signal msem)
-  let threadSet' = Set.insert childThread threadSet
-  putMVar mvar threadSet'
-  return childThread
+  modifyMVar mvar $ \threadSet -> do
+    childThread <- liftBaseDiscard (httpStateForkPrimitive state)
+      $ finally action
+                (do
+                  modifyMVar_ mvar $ \threadSet -> do
+                    self <- myThreadId
+                    let threadSet' = Set.delete self threadSet'
+                    return threadSet'
+                  liftBase $ MSem.signal msem)
+    let threadSet' = Set.insert childThread threadSet
+    return (threadSet', childThread)
 
 
 -- | A record used to configure the server.  Broken informally into the four
@@ -641,13 +641,31 @@
   let getHeadersValid = do
         connection <- getHTTPConnection
         headerMap <- readMVar $ httpConnectionRequestHeaderMap connection
-        return $ all (\header -> (isValidInRequest header)
-                                 && (hasContent
-                                     || (not $ isValidOnlyWithEntity header)))
-                     $ Map.keys headerMap
+        foldM (\result header -> do
+                 if isValidInRequest header
+                   then return result
+                   else do
+                     if hasContent
+                       then return result
+                       else if not $ isValidOnlyWithEntity header
+                         then return result
+                         else do
+                           httpLog $ "Header " ++ (show header)
+                                     ++ " is valid only with an entity."
+                           return False)
+              True
+              (Map.keys headerMap)
       getContentValid = do
         contentAllowed <- getRequestContentAllowed
-        return $ contentAllowed || not hasContent
+        if contentAllowed
+          then return True
+          else if not hasContent
+            then return True
+            else do
+              method <- getRequestMethod
+              httpLog $ "Content provided but not allowed with "
+                        ++ method ++ "."
+              return False
   httpVersion <- getRequestProtocol
   case httpVersion of
     "HTTP/1.0" -> do
@@ -660,8 +678,10 @@
       mandatoryHeadersIncluded <- do
         maybeHost <- getRequestHeader HttpHost
         case maybeHost of
-          Nothing -> return False
-          Just host -> return True
+          Just _ -> return True
+          Nothing -> do
+            httpLog $ "Host header not provided and HTTP/1.1 used."
+            return False
       return $ and [headersValid, mandatoryHeadersIncluded, contentValid]
     _ -> return False
 
@@ -882,57 +902,56 @@
 recvHeaders = do
   HTTPConnection { httpConnectionInputBufferMVar = inputBufferMVar }
     <- getHTTPConnection
-  inputBuffer <- takeMVar inputBufferMVar
-  (inputBuffer, maybeLine) <- recvLine inputBuffer
-  (inputBuffer, result) <- case maybeLine of
-    Nothing -> return (inputBuffer, Nothing)
-    Just line -> do
-      let computeWords input =
-            let (before, after) = BS.breakSubstring (UTF8.fromString " ") input
-            in if BS.null after
-              then [before]
-              else let rest = computeWords $ BS.drop 1 after
-                   in before : rest
-          words = computeWords line
-      case words of
-        [method, url, protocol]
-          | (isValidMethod method)
-            && (isValidURL url)
-            && (isValidProtocol protocol)
-          -> do
-            let loop inputBuffer headersSoFar = do
-                  (inputBuffer, maybeLine) <- recvLine inputBuffer
-                  case maybeLine of
-                    Nothing -> return (inputBuffer, Nothing)
-                    Just line
-                      | BS.null line -> do
-                          return (inputBuffer,
-                                  Just (method, url, protocol, headersSoFar))
-                      | otherwise -> do
-                          case parseHeader line of
-                            Nothing -> do
-                              logInvalidRequest
-                              return (inputBuffer, Nothing)
-                            Just (header, value) -> do
-                              let headersSoFar'
-                                   = case Map.lookup header headersSoFar of
-                                       Nothing -> Map.insert header
-                                                             value
-                                                             headersSoFar
-                                       Just oldValue
-                                         -> Map.insert
-                                            header
-                                            (BS.concat [oldValue,
-                                                        (UTF8.fromString ","),
-                                                        value])
-                                            headersSoFar
-                              loop inputBuffer headersSoFar'
-            loop inputBuffer Map.empty
-        _ -> do
-          logInvalidRequest
-          return (inputBuffer, Nothing)
-  putMVar inputBufferMVar inputBuffer
-  return result
+  modifyMVar inputBufferMVar $ \inputBuffer -> do
+    (inputBuffer, maybeLine) <- recvLine inputBuffer
+    (inputBuffer, result) <- case maybeLine of
+      Nothing -> return (inputBuffer, Nothing)
+      Just line -> do
+        let computeWords input =
+              let (before, after) = BS.breakSubstring (UTF8.fromString " ") input
+              in if BS.null after
+                then [before]
+                else let rest = computeWords $ BS.drop 1 after
+                     in before : rest
+            words = computeWords line
+        case words of
+          [method, url, protocol]
+            | (isValidMethod method)
+              && (isValidURL url)
+              && (isValidProtocol protocol)
+            -> do
+              let loop inputBuffer headersSoFar = do
+                    (inputBuffer, maybeLine) <- recvLine inputBuffer
+                    case maybeLine of
+                      Nothing -> return (inputBuffer, Nothing)
+                      Just line
+                        | BS.null line -> do
+                            return (inputBuffer,
+                                    Just (method, url, protocol, headersSoFar))
+                        | otherwise -> do
+                            case parseHeader line of
+                              Nothing -> do
+                                logInvalidRequest
+                                return (inputBuffer, Nothing)
+                              Just (header, value) -> do
+                                let headersSoFar'
+                                     = case Map.lookup header headersSoFar of
+                                         Nothing -> Map.insert header
+                                                               value
+                                                               headersSoFar
+                                         Just oldValue
+                                           -> Map.insert
+                                              header
+                                              (BS.concat [oldValue,
+                                                          (UTF8.fromString ","),
+                                                          value])
+                                              headersSoFar
+                                loop inputBuffer headersSoFar'
+              loop inputBuffer Map.empty
+          _ -> do
+            logInvalidRequest
+            return (inputBuffer, Nothing)
+    return (inputBuffer, result)
 
 
 parseHeader :: ByteString -> Maybe (Header, ByteString)
@@ -996,13 +1015,12 @@
 
 recvBlock :: (MonadHTTP m) => Int -> m ByteString
 recvBlock length = do
-  HTTPConnection { httpConnectionInputBufferMVar = inputBufferMVar } <- getHTTPConnection
-  inputBuffer <- takeMVar inputBufferMVar
-  (inputBuffer, endOfInput)
-    <- extendInputBuffer inputBuffer length True
-  (result, inputBuffer) <- return $ BS.splitAt length inputBuffer
-  putMVar inputBufferMVar inputBuffer
-  return result
+  HTTPConnection { httpConnectionInputBufferMVar = inputBufferMVar } <-
+    getHTTPConnection
+  modifyMVar inputBufferMVar $ \inputBuffer -> do
+    (inputBuffer, endOfInput) <- extendInputBuffer inputBuffer length True
+    (result, inputBuffer) <- return $ BS.splitAt length inputBuffer
+    return (inputBuffer, result)
 
 
 extendInputBuffer :: (MonadHTTP m)
@@ -1384,21 +1402,19 @@
 getRequestCookieMap = do
   connection <- getHTTPConnection
   let mvar = httpConnectionRequestCookieMap connection
-  maybeCookieMap <- takeMVar mvar
-  case maybeCookieMap of
-    Just cookieMap -> do
-      putMVar mvar maybeCookieMap
-      return cookieMap
-    Nothing -> do
-      maybeCookieString <- getRequestHeader HttpCookie
-      let cookieMap =
-            case maybeCookieString of
-              Nothing -> Map.empty
-              Just cookieString ->
-                Map.fromList (map (\cookie -> (cookieName cookie, cookie))
-                                  (parseCookies cookieString))
-      putMVar mvar (Just cookieMap)
-      return cookieMap
+  modifyMVar mvar $ \maybeCookieMap -> do
+    case maybeCookieMap of
+      Just cookieMap -> do
+        return (maybeCookieMap, cookieMap)
+      Nothing -> do
+        maybeCookieString <- getRequestHeader HttpCookie
+        let cookieMap =
+              case maybeCookieString of
+                Nothing -> Map.empty
+                Just cookieString ->
+                  Map.fromList (map (\cookie -> (cookieName cookie, cookie))
+                                    (parseCookies cookieString))
+        return (Just cookieMap, cookieMap)
 
 
 -- | Return the remote address, which includes both host and port information.
@@ -1491,12 +1507,12 @@
 getRequestHasContent = do
   HTTPConnection { httpConnectionRequestContentParameters = parametersMVar }
     <- getHTTPConnection
-  parameters <- takeMVar parametersMVar
-  parameters <- ensureRequestContentParametersInitialized parameters
-  putMVar parametersMVar parameters
-  return $ case parameters of
-    RequestContentNone -> False
-    _ -> True
+  modifyMVar parametersMVar $ \parameters -> do
+    parameters <- ensureRequestContentParametersInitialized parameters
+    let result = case parameters of
+                   RequestContentNone -> False
+                   _ -> True
+    return (parameters, result)
 
 
 getRequestContentAllowed :: (MonadHTTP m) => m Bool
@@ -1547,13 +1563,13 @@
 httpIsReadable = do
   HTTPConnection { httpConnectionRequestContentParameters = parametersMVar }
     <- getHTTPConnection
-  parameters <- takeMVar parametersMVar
-  parameters <- ensureRequestContentParametersInitialized parameters
-  putMVar parametersMVar parameters
-  return $ case parameters of
-             RequestContentNone -> False
-             RequestContentClosed -> False
-             _ -> True
+  modifyMVar parametersMVar $ \parameters -> do
+    parameters <- ensureRequestContentParametersInitialized parameters
+    let result = case parameters of
+                   RequestContentNone -> False
+                   RequestContentClosed -> False
+                   _ -> True
+    return (parameters, result)
 
 
 httpGet' :: (MonadHTTP m) => (Maybe Int) -> Bool -> Bool -> m BS.ByteString
@@ -1561,21 +1577,14 @@
   if not discarding
     then requireOutputNotYetClosed
     else return ()
-  HTTPConnection {
-      httpConnectionRequestContentBuffer = bufferMVar,
-      httpConnectionRequestContentParameters = parametersMVar
-    } <- getHTTPConnection
-  buffer <- takeMVar bufferMVar
-  parameters <- takeMVar parametersMVar
-  parameters <- ensureRequestContentParametersInitialized parameters
-  (buffer, parameters)
-    <- extendRequestContentBuffer buffer parameters maybeSize blocking
-  (result, buffer) <- return $ case maybeSize of
-                        Nothing -> (buffer, BS.empty)
-                        Just size -> BS.splitAt size buffer
-  putMVar parametersMVar parameters
-  putMVar bufferMVar buffer
-  return result
+  modifyRequest $ \buffer parameters -> do
+    parameters <- ensureRequestContentParametersInitialized parameters
+    (buffer, parameters)
+      <- extendRequestContentBuffer buffer parameters maybeSize blocking
+    (result, buffer) <- return $ case maybeSize of
+                          Nothing -> (buffer, BS.empty)
+                          Just size -> BS.splitAt size buffer
+    return (buffer, parameters, result)
 
 
 ensureRequestContentParametersInitialized
@@ -1653,11 +1662,10 @@
                  -- TODO IAK
   HTTPConnection { httpConnectionInputBufferMVar = lowLevelBufferMVar }
     <- getHTTPConnection
-  lowLevelBuffer <- takeMVar lowLevelBufferMVar
-  (highLevelBuffer, lowLevelBuffer, parameters)
-    <- loop highLevelBuffer lowLevelBuffer parameters
-  putMVar lowLevelBufferMVar lowLevelBuffer
-  return (highLevelBuffer, parameters)
+  modifyMVar lowLevelBufferMVar $ \lowLevelBuffer -> do
+    (highLevelBuffer, lowLevelBuffer, parameters)
+      <- loop highLevelBuffer lowLevelBuffer parameters
+    return (lowLevelBuffer, (highLevelBuffer, parameters))
 
 
 -- | Sets the response status which will be sent with the response headers.  If
@@ -1718,9 +1726,9 @@
     then do
       connection <- getHTTPConnection
       let mvar = httpConnectionResponseHeaderMap connection
-      headerMap <- takeMVar mvar
-      let headerMap' = Map.insert header (UTF8.fromString value) headerMap
-      putMVar mvar headerMap'
+      modifyMVar_ mvar $ \headerMap -> do
+        let headerMap' = Map.insert header (UTF8.fromString value) headerMap
+        return headerMap'
     else throwIO $ NotAResponseHeader header
 
 
@@ -1745,9 +1753,9 @@
   if isValidInResponse header
     then do
       HTTPConnection { httpConnectionResponseHeaderMap = mvar } <- getHTTPConnection
-      headerMap <- takeMVar mvar
-      headerMap <- return $ Map.delete header headerMap
-      putMVar mvar headerMap
+      modifyMVar_ mvar $ \headerMap -> do
+        headerMap <- return $ Map.delete header headerMap
+        return headerMap
     else throwIO $ NotAResponseHeader header
 
 
@@ -1789,10 +1797,10 @@
   requireValidCookieName $ cookieName cookie
   connection <- getHTTPConnection
   let mvar = httpConnectionResponseCookieMap connection
-  responseCookieMap <- takeMVar mvar
-  let responseCookieMap' =
-        Map.insert (cookieName cookie) cookie responseCookieMap
-  putMVar mvar responseCookieMap'
+  modifyMVar_ mvar $ \responseCookieMap -> do
+    let responseCookieMap' =
+          Map.insert (cookieName cookie) cookie responseCookieMap
+    return responseCookieMap'
 
 
 -- | Causes the user agent to unset any cookie applicable to this page with the
@@ -1814,10 +1822,10 @@
   requireValidCookieName name
   connection <- getHTTPConnection
   let mvar = httpConnectionResponseCookieMap connection
-  responseCookieMap <- takeMVar mvar
-  let responseCookieMap' =
-        Map.insert name (mkUnsetCookie name) responseCookieMap
-  putMVar mvar responseCookieMap'
+  modifyMVar_ mvar $ \responseCookieMap -> do
+    let responseCookieMap' =
+          Map.insert name (mkUnsetCookie name) responseCookieMap
+    return responseCookieMap'
 
 
 -- | Constructs a cookie with the given name and value.  Version is set to 1;
@@ -1968,22 +1976,23 @@
       modifiableMVar = httpConnectionResponseHeadersModifiable connection
       parametersMVar = httpConnectionResponseContentParameters connection
       bufferMVar = httpConnectionResponseContentBuffer connection
-  parameters <- takeMVar parametersMVar
-  parameters <- ensureResponseContentParametersInitialized parameters
-  putMVar parametersMVar parameters
-  alreadySent <- takeMVar alreadySentMVar
-  if not alreadySent
-    then do
-      _ <- swapMVar modifiableMVar False
-      case parameters of
-        ResponseContentBufferedIdentity -> do
-          buffer <- readMVar bufferMVar
-          setResponseHeader' HttpContentLength (show $ BS.length buffer)
-        _ -> do
-          headersBuffer <- getHeadersBuffer
-          send headersBuffer
-    else return ()
-  putMVar alreadySentMVar True
+  parameters <-
+    modifyMVar parametersMVar $ \parameters -> do
+      parameters <- ensureResponseContentParametersInitialized parameters
+      return (parameters, parameters)
+  modifyMVar_ alreadySentMVar $ \alreadySent -> do
+    if not alreadySent
+      then do
+        _ <- swapMVar modifiableMVar False
+        case parameters of
+          ResponseContentBufferedIdentity -> do
+            buffer <- readMVar bufferMVar
+            setResponseHeader' HttpContentLength (show $ BS.length buffer)
+          _ -> do
+            headersBuffer <- getHeadersBuffer
+            send headersBuffer
+      else return ()
+    return True
 
 
 getHeadersBuffer :: (MonadHTTP m) => m ByteString
@@ -2138,53 +2147,54 @@
   requireOutputNotYetClosed
   markResponseHeadersUnmodifiable
   connection <- getHTTPConnection
-  let bufferMVar = httpConnectionResponseContentBuffer connection
-      parametersMVar = httpConnectionResponseContentParameters connection
-      alreadySentMVar = httpConnectionResponseHeadersSent connection
-  buffer <- takeMVar bufferMVar
-  parameters <- takeMVar parametersMVar
-  parameters <- ensureResponseContentParametersInitialized parameters
-  (buffer, parameters) <- case parameters of
-    ResponseContentClosed -> throwIO OutputAlreadyClosed
-    ResponseContentBufferedIdentity -> do
-      return (BS.append buffer bytestring, ResponseContentBufferedIdentity)
-    ResponseContentUnbufferedIdentity lengthRemaining -> do
-      alreadySent <- takeMVar alreadySentMVar
-      if alreadySent
-        then return ()
-        else do
-          headersBuffer <- getHeadersBuffer
-          send headersBuffer
-      putMVar alreadySentMVar True
-      let lengthThisPut = BS.length bytestring
-      if lengthThisPut > lengthRemaining
-        then do
-          putMVar parametersMVar ResponseContentClosed
-          putMVar bufferMVar BS.empty
-          throwIO OutputAlreadyClosed
-        else do
-          let parameters' = ResponseContentUnbufferedIdentity
-                             $ lengthRemaining - lengthThisPut
-          send bytestring
-          return (buffer, parameters')
-    ResponseContentChunked -> do
-      alreadySent <- takeMVar alreadySentMVar
-      if alreadySent
-        then return ()
-        else do
-          headersBuffer <- getHeadersBuffer
-          send headersBuffer
-      putMVar alreadySentMVar True
-      if BS.length bytestring > 0
-        then do
-          let lengthBuffer =
-                UTF8.fromString $ showHex (BS.length bytestring) "" ++ "\r\n"
-              crlfBuffer = UTF8.fromString "\r\n"
-          send $ BS.concat [lengthBuffer, bytestring, crlfBuffer]
-        else return ()
-      return (buffer, parameters)
-  putMVar parametersMVar parameters
-  putMVar bufferMVar buffer
+  let alreadySentMVar = httpConnectionResponseHeadersSent connection
+  maybeException <- do
+    modifyResponse $ \buffer parameters -> do
+      parameters <- ensureResponseContentParametersInitialized parameters
+      case parameters of
+        ResponseContentClosed -> do
+          return (buffer, parameters, Just OutputAlreadyClosed)
+        ResponseContentBufferedIdentity -> do
+          return (BS.append buffer bytestring, parameters, Nothing)
+        ResponseContentUnbufferedIdentity lengthRemaining -> do
+          modifyMVar_ alreadySentMVar $ \alreadySent -> do
+            if alreadySent
+              then return ()
+              else do
+                headersBuffer <- getHeadersBuffer
+                send headersBuffer
+            return True
+          let lengthThisPut = BS.length bytestring
+          if lengthThisPut > lengthRemaining
+            then do
+              return (BS.empty,
+                      ResponseContentClosed,
+                      Just OutputAlreadyClosed)
+            else do
+              let parameters' = ResponseContentUnbufferedIdentity
+                                 $ lengthRemaining - lengthThisPut
+              send bytestring
+              return (buffer, parameters', Nothing)
+        ResponseContentChunked -> do
+          modifyMVar_ alreadySentMVar $ \alreadySent -> do
+            if alreadySent
+              then return ()
+              else do
+                headersBuffer <- getHeadersBuffer
+                send headersBuffer
+            return True
+          if BS.length bytestring > 0
+            then do
+              let lengthBuffer =
+                    UTF8.fromString $ showHex (BS.length bytestring) ""
+                                      ++ "\r\n"
+                  crlfBuffer = UTF8.fromString "\r\n"
+              send $ BS.concat [lengthBuffer, bytestring, crlfBuffer]
+            else return ()
+          return (buffer, parameters, Nothing)
+  case maybeException of
+    Nothing -> return ()
+    Just exception -> throwIO exception
 
 
 ensureResponseContentParametersInitialized
@@ -2216,34 +2226,34 @@
 ensureResponseContentParametersInitialized parameters = return parameters
 
 
-flushResponseContent :: (MonadHTTP m) => m ()
-flushResponseContent = do
+finishResponseContent :: (MonadHTTP m) => m ()
+finishResponseContent = do
   connection <- getHTTPConnection
   let bufferMVar = httpConnectionResponseContentBuffer connection
       parametersMVar = httpConnectionResponseContentParameters connection
-  buffer <- takeMVar bufferMVar
-  parameters <- takeMVar parametersMVar
-  parameters <- ensureResponseContentParametersInitialized parameters
-  case parameters of
-    ResponseContentClosed -> throwIO OutputAlreadyClosed
-    ResponseContentBufferedIdentity -> do
-      headersBuffer <- getHeadersBuffer
-      send $ BS.concat [headersBuffer, buffer]
-      return ()
-    ResponseContentUnbufferedIdentity lengthRemaining -> do
-      if lengthRemaining > 0
-        then do
-          putMVar parametersMVar ResponseContentClosed
-          putMVar bufferMVar BS.empty
-          throwIO OutputIncomplete
-        else return ()
-    ResponseContentChunked -> do
-      let emptyChunkBuffer = UTF8.fromString $ "0\r\n\r\n\r\n"
-      send emptyChunkBuffer
-      putMVar parametersMVar parameters
-      putMVar bufferMVar buffer
-  putMVar parametersMVar ResponseContentClosed
-  putMVar bufferMVar BS.empty
+  maybeException <-
+    modifyResponse $ \buffer parameters -> do
+      parameters <- ensureResponseContentParametersInitialized parameters
+      result <-
+        case parameters of
+          ResponseContentClosed -> do
+            return $ Just OutputAlreadyClosed
+          ResponseContentBufferedIdentity -> do
+            headersBuffer <- getHeadersBuffer
+            send $ BS.concat [headersBuffer, buffer]
+            return Nothing
+          ResponseContentUnbufferedIdentity lengthRemaining -> do
+            if lengthRemaining > 0
+              then return $ Just OutputIncomplete
+              else return Nothing
+          ResponseContentChunked -> do
+            let emptyChunkBuffer = UTF8.fromString $ "0\r\n\r\n\r\n"
+            send emptyChunkBuffer
+            return Nothing
+      return (BS.empty, ResponseContentClosed, result)
+  case maybeException of
+    Nothing -> return ()
+    Just exception -> throwIO exception
 
 
 send :: (MonadHTTP m) => ByteString -> m ()
@@ -2273,7 +2283,7 @@
 httpCloseOutput = do
   requireOutputNotYetClosed
   sendResponseHeaders
-  flushResponseContent
+  finishResponseContent
   httpGet' Nothing True True
   return ()
 
@@ -2284,12 +2294,12 @@
 httpIsWritable = do
   connection <- getHTTPConnection
   let parametersMVar = httpConnectionResponseContentParameters connection
-  parameters <- takeMVar parametersMVar
-  parameters <- ensureResponseContentParametersInitialized parameters
-  putMVar parametersMVar parameters
-  return $ case parameters of
-             ResponseContentClosed -> False
-             _ -> True
+  modifyMVar parametersMVar $ \parameters -> do
+    parameters <- ensureResponseContentParametersInitialized parameters
+    let result = case parameters of
+                   ResponseContentClosed -> False
+                   _ -> True
+    return (parameters, result)
 
 
 requireResponseHeadersNotYetSent :: (MonadHTTP m) => m ()
@@ -2315,3 +2325,36 @@
     False -> throwIO OutputAlreadyClosed
     True -> return ()
 
+
+modifyRequest
+  :: (MonadHTTP m)
+  => (ByteString
+      -> RequestContentParameters
+      -> m (ByteString, RequestContentParameters, a))
+  -> m a
+modifyRequest action = do
+  HTTPConnection {
+      httpConnectionRequestContentBuffer = bufferMVar,
+      httpConnectionRequestContentParameters = parametersMVar
+    } <- getHTTPConnection
+  modifyMVar bufferMVar $ \buffer -> do
+    modifyMVar parametersMVar $ \parameters -> do
+      (buffer, parameters, result) <- action buffer parameters
+      return (parameters, (buffer, result))
+
+
+modifyResponse
+  :: (MonadHTTP m)
+  => (ByteString
+      -> ResponseContentParameters
+      -> m (ByteString, ResponseContentParameters, a))
+  -> m a
+modifyResponse action = do
+  HTTPConnection {
+      httpConnectionResponseContentBuffer = bufferMVar,
+      httpConnectionResponseContentParameters = parametersMVar
+    } <- getHTTPConnection
+  modifyMVar bufferMVar $ \buffer -> do
+    modifyMVar parametersMVar $ \parameters -> do
+      (buffer, parameters, result) <- action buffer parameters
+      return (parameters, (buffer, result))
diff --git a/direct-http.cabal b/direct-http.cabal
--- a/direct-http.cabal
+++ b/direct-http.cabal
@@ -1,5 +1,5 @@
 name: direct-http
-version: 0.5.3
+version: 0.6
 cabal-version: >= 1.10
 build-type: Simple
 license: BSD3
@@ -21,6 +21,9 @@
   author, but is intended more by way of a replacement for it than a companion
   to it, and makes several design decisions differently.  The biggest is the
   use of MonadControlBase for exceptions.
+  .
+  [Version 0.6] Substantial reworking of MVar handling, using safer primitives
+  to be much more robust in the face of exceptions in pure code.
   .
   [Version 0.5.3] Actually works with extension headers, by admitting the
   reality that they can occur anytime and not just with an entity.