git.iko.soy/typeable/wai
on master help sign in
Move Accept-Ranges into adjustForFilePart

This way HTTP/2 will set this header too. Relevant to #431.

commitcfe9824a22be210f5b58285b566b2f03b64f431b authorAndrew Pritchard <awpr@google.com> dateSat 12 Sep 2015, 10:33 (11 years ago) parent8c8359f
3 files changed+18−15
compare with master
unifiedsplit
wai/Network/Wai/HTTP2.hs+6−3 wai/Network/Wai/Internal.hs+7−3 warp/Network/Wai/Handler/Warp/Response.hs+5−9
wai/Network/Wai/HTTP2.hs+6−3
@@ -149,11 +149,14 @@ promiseHeaders p =
149149streamFilePart :: FilePath -> FilePart -> Body ()
150150streamFilePart path part write _ = write $ FileChunk path part
151151
152−-- | Respond with a single range of a file, adding the Content-Length and
153−-- Content-Range headers and changing the status to 206 as appropriate.
152+-- | Respond with a single range of a file, adding the Accept-Ranges,
153+-- Content-Length and Content-Range headers and changing the status to 206 as
154+-- appropriate.
154155--
155156-- If you want the range to be inferred automatically from the Range header,
156−-- use 'respondFile' instead.
157+-- use 'respondFile' instead. On the other hand, if you want to avoid the
158+-- automatic header and status adjustments, use 'respond' and 'streamFilePart'
159+-- directly.
157160respondFilePart :: H.Status -> H.ResponseHeaders -> FilePath -> FilePart -> Responder
158161respondFilePart s h path part = Responder $ \k -> do
159162 let (s', h') = adjustForFilePart s h part
wai/Network/Wai/Internal.hs+7−3
@@ -167,6 +167,10 @@ tryGetFileSize path =
167167hContentRange :: H.HeaderName
168168hContentRange = "Content-Range"
169169
170+-- | \"Accept-Ranges\".
171+hAcceptRanges :: H.HeaderName
172+hAcceptRanges = "Accept-Ranges"
173+
170174-- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'
171175-- for the range specified.
172176contentRangeHeader :: Integer -> Integer -> Integer -> H.Header
@@ -200,8 +204,8 @@ chooseFilePart size (Just range) = case parseByteRanges range >>= listToMaybe of
200204
201205-- | Adjust the given 'H.Status' and 'H.ResponseHeaders' based on the given
202206-- 'FilePart'. This means replacing the status with 206 if the response is
203−-- partial, and adding the Content-Length (always) and Content-Range (if
204−-- appropriate) headers.
207+-- partial, and adding the Content-Length and Accept-Ranges (always) and
208+-- Content-Range (if appropriate) headers.
205209adjustForFilePart :: H.Status -> H.ResponseHeaders -> FilePart -> (H.Status, H.ResponseHeaders)
206210adjustForFilePart s h part = (s', h'')
207211 where
@@ -212,7 +216,7 @@ adjustForFilePart s h part = (s', h'')
212216 contentRange = contentRangeHeader off (off + len - 1) size
213217 lengthBS = L.toStrict $ B.toLazyByteString $ B.integerDec len
214218 s' = if filePartByteCount part /= size then H.partialContent206 else s
215− h' = (H.hContentLength, lengthBS):h
219+ h' = (H.hContentLength, lengthBS):(hAcceptRanges, "bytes"):h
216220 h'' = (if len == size then id else (contentRange:)) h'
217221
218222-- | Parse the value of a Range header into a 'HH.ByteRanges'.
warp/Network/Wai/Handler/Warp/Response.hs+5−9
@@ -196,19 +196,19 @@ sendRsp :: Connection
196196 -> Rsp
197197 -> IO ()
198198sendRsp conn mfdc ver s0 hs0 (RspFile path mPart mRange isHead hook) = do
199− ex <- fileRange s0 hs path mPart mRange
199+ ex <- fileRange s0 hs0 path mPart mRange
200200 case ex of
201201 Left _ex ->
202202#ifdef WARP_DEBUG
203203 print _ex >>
204204#endif
205205 sendRsp conn mfdc ver s2 hs2 (RspBuilder body True)
206− Right (s, hs1, beg, len)
206+ Right (s, hs, beg, len)
207207 | len >= 0 ->
208208 if isHead then
209− sendRsp conn mfdc ver s hs1 (RspBuilder mempty False)
209+ sendRsp conn mfdc ver s hs (RspBuilder mempty False)
210210 else do
211− lheader <- composeHeader ver s hs1
211+ lheader <- composeHeader ver s hs
212212#ifdef WINDOWS
213213 let fid = FileId path Nothing
214214 hook' = hook
@@ -224,10 +224,9 @@ sendRsp conn mfdc ver s0 hs0 (RspFile path mPart mRange isHead hook) = do
224224 connSendFile conn fid beg len hook' [lheader]
225225 | otherwise ->
226226 sendRsp conn mfdc ver H.status416
227− (filter (\(k, _) -> k /= "content-length") hs1)
227+ (filter (\(k, _) -> k /= "content-length") hs)
228228 (RspBuilder mempty True)
229229 where
230− hs = addAcceptRanges hs0
231230 s2 = H.status404
232231 hs2 = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0
233232 body = byteString "File not found"
@@ -351,9 +350,6 @@ hasBody s = sc /= 204
351350
352351----------------------------------------------------------------
353352
354−addAcceptRanges :: H.ResponseHeaders -> H.ResponseHeaders
355−addAcceptRanges hdrs = (hAcceptRanges, "bytes") : hdrs
356−
357353addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders
358354addTransferEncoding hdrs = (hTransferEncoding, "chunked") : hdrs
359355