git.iko.soy/typeable/wai
on master help sign in
HEAD and 204 support
b18e687Michael Snoyman
Network/Wai/Handler/Warp.hs+18−6
compare with master
unifiedsplit
@@ -83,7 +83,7 @@ serveConnection port app conn remoteHost' = do
83 res <- app env
83 res <- app env
84 remaining <- readIORef ilen
84 remaining <- readIORef ilen
85 _ <- B.hGet conn remaining -- FIXME just skip, don't read
85 _ <- B.hGet conn remaining -- FIXME just skip, don't read
86− keepAlive <- sendResponse (httpVersion env) conn res
86+ keepAlive <- sendResponse env (httpVersion env) conn res
87 hFlush conn
87 hFlush conn
88 when keepAlive serveConnection'
88 when keepAlive serveConnection'
89
89
@@ -197,14 +197,26 @@ headers httpversion status responseHeaders isChunked' = mconcat
197isChunked :: HttpVersion -> Bool
197isChunked :: HttpVersion -> Bool
198isChunked = (==) http11
198isChunked = (==) http11
199
199
200+hasBody :: Status -> Request -> Bool
201+hasBody s req = s /= (Status 204 "") && requestMethod req /= "HEAD"
202+
200−sendResponse :: HttpVersion -> Handle -> Response -> IO Bool
203+sendResponse :: Request -> HttpVersion -> Handle -> Response -> IO Bool
201−sendResponse hv handle (ResponseFile s hs fp) = do
204+sendResponse req hv handle (ResponseFile s hs fp) = do
202 mapM_ (S.hPut handle) $ L.toChunks $ toLazyByteString $ headers hv s hs False
205 mapM_ (S.hPut handle) $ L.toChunks $ toLazyByteString $ headers hv s hs False
206+ if hasBody s req
207+ then do
203− unsafeSendFile handle fp
208+ unsafeSendFile handle fp
204− return $ lookup "content-length" hs /= Nothing
209+ return $ lookup "content-length" hs /= Nothing
210+ else return True
205−sendResponse hv handle (ResponseEnumerator res) =
211+sendResponse req hv handle (ResponseEnumerator res) =
206 res go
212 res go
207 where
213 where
214+ go s hs
215+ | not (hasBody s req) = do
216+ liftIO $ mapM_ (S.hPut handle)
217+ $ L.toChunks $ toLazyByteString
218+ $ headers hv s hs False
219+ return True
208 go s hs =
220 go s hs =
209 chunk'
221 chunk'
210 $ E.enumList 1 [headers hv s hs isChunked']
222 $ E.enumList 1 [headers hv s hs isChunked']
statuses.hsnew file+18
@@ -0,0 +1,18 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+import Network.Wai
3+import Network.Wai.Handler.Warp
4+import Data.ByteString.Lazy.Char8 (pack)
5+import qualified Data.ByteString.Char8 as S
6+
7+main = run 3000 app
8+
9+app req =
10+ return $ responseLBS (Status s' s) [("Content-Type", "text/plain")]
11+ $ pack $ concat
12+ [ "The status code is "
13+ , S.unpack s
14+ , ". Have a nice day!"
15+ ]
16+ where
17+ s = S.dropWhile (== '/') $ pathInfo req
18+ s' = read $ S.unpack s