git.iko.soy/typeable/wai
on master help sign in
Merge remote-tracking branch 'origin/get-head'
commitc1611aec1f4e32e5828093e8b1d2b14caa7e6e62 authorMichael Snoyman <michael@snoyman.com> dateFri 3 Apr 2015, 05:47 (12 years ago) parent59ad5460838caa
3 files changed+14−11
compare with master
unifiedsplit
wai-app-static/Network/Wai/Application/Static.hs+2−2 wai-app-static/WaiAppStatic/CmdLine.hs−2 warp/Network/Wai/Handler/Warp/Response.hs+12−7
wai-app-static/Network/Wai/Application/Static.hs+2−2
@@ -214,10 +214,10 @@ staticApp set req = staticAppPieces set (W.pathInfo req) req
214214
215215staticAppPieces :: StaticSettings -> [Text] -> W.Application
216216staticAppPieces _ _ req sendResponse
217− | W.requestMethod req /= "GET" = sendResponse $ W.responseLBS
217+ | notElem (W.requestMethod req) ["GET", "HEAD"] = sendResponse $ W.responseLBS
218218 H.status405
219219 [("Content-Type", "text/plain")]
220− "Only GET is supported"
220+ "Only GET or HEAD is supported"
221221staticAppPieces _ [".hidden", "folder.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]
222222staticAppPieces _ [".hidden", "haskell.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]
223223staticAppPieces ss rawPieces req sendResponse = liftIO $ do
wai-app-static/WaiAppStatic/CmdLine.hs−2
@@ -14,7 +14,6 @@ import Options.Applicative
1414import Text.Printf (printf)
1515import System.Directory (canonicalizePath)
1616import Control.Monad (unless)
17−import Network.Wai.Middleware.Autohead
1817import Network.Wai.Middleware.RequestLogger (logStdout)
1918import Network.Wai.Middleware.Gzip
2019import qualified Data.Map as Map
@@ -100,7 +99,6 @@ runCommandLine middleware = do
10099 unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)
101100 let middle = gzip def { gzipFiles = GzipCompress }
102101 . (if verbose then logStdout else id)
103− . autohead
104102 . (middleware args)
105103 runSettings defaultSettings
106104 { settingsPort = port
warp/Network/Wai/Handler/Warp/Response.hs+12−7
@@ -174,6 +174,7 @@ sendResponse :: ByteString -- ^ default server value
174174sendResponse defServer conn ii req reqidxhdr src response = do
175175 hs <- addServerAndDate hs0
176176 if hasBody s req then do
177+ -- HEAD comes here even if it does not have body.
177178 sendRsp conn ver s hs rsp
178179 T.tickle th
179180 return ret
@@ -192,8 +193,9 @@ sendResponse defServer conn ii req reqidxhdr src response = do
192193 mRange = reqidxhdr ! idxRange
193194 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
194195 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo
196+ isHead = requestMethod req == H.methodHead
195197 rsp = case response of
196− ResponseFile _ _ path mPart -> RspFile path mPart mRange (T.tickle th)
198+ ResponseFile _ _ path mPart -> RspFile path mPart mRange isHead (T.tickle th)
197199 ResponseBuilder _ _ b -> RspBuilder b needsChunked
198200 ResponseStream _ _ fb -> RspStream fb needsChunked th
199201 ResponseRaw raw _ -> RspRaw raw src (T.tickle th)
@@ -205,7 +207,7 @@ sendResponse defServer conn ii req reqidxhdr src response = do
205207
206208----------------------------------------------------------------
207209
208−data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) (IO ())
210+data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) Bool (IO ())
209211 | RspBuilder Builder Bool
210212 | RspStream StreamingBody Bool T.Handle
211213 | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) (IO ())
@@ -218,7 +220,7 @@ sendRsp :: Connection
218220 -> H.ResponseHeaders
219221 -> Rsp
220222 -> IO ()
221−sendRsp conn ver s0 hs0 (RspFile path mPart mRange hook) = do
223+sendRsp conn ver s0 hs0 (RspFile path mPart mRange isHead hook) = do
222224 ex <- fileRange s0 hs path mPart mRange
223225 case ex of
224226 Left _ex ->
@@ -226,9 +228,13 @@ sendRsp conn ver s0 hs0 (RspFile path mPart mRange hook) = do
226228 print _ex >>
227229#endif
228230 sendRsp conn ver s2 hs2 (RspBuilder body True)
229− Right (s, hs1, beg, len) | len >= 0 -> do
230− lheader <- composeHeader ver s hs1
231− connSendFile conn path beg len hook [lheader]
231+ Right (s, hs1, beg, len)
232+ | len >= 0 ->
233+ if isHead then
234+ sendRsp conn ver s hs1 (RspBuilder mempty False)
235+ else do
236+ lheader <- composeHeader ver s hs1
237+ connSendFile conn path beg len hook [lheader]
232238 | otherwise -> do
233239 sendRsp conn ver H.status416
234240 (filter (\(k, _) -> k /= "content-length") hs1)
@@ -353,7 +359,6 @@ hasBody :: H.Status -> Request -> Bool
353359hasBody s req = sc /= 204
354360 && sc /= 304
355361 && sc >= 200
356− && method /= H.methodHead
357362 where
358363 sc = H.statusCode s
359364 method = requestMethod req