@@ -5,6 +5,7 @@
55
66module Network.Wai.Handler.Warp.Response (
77 sendResponse
8+ , fileRange -- for testing
89 ) where
910
1011import Blaze.ByteString.Builder (fromByteString, Builder, toByteStringIO, flush)
@@ -34,61 +35,56 @@ import qualified System.PosixCompat.Files as P
3435
3536----------------------------------------------------------------
3637
37−-- Application should just specify FilePart.
38−-- Content-Length and Content-Range are automatically added.
39−-- Application should not be specify Content-Length and Content-Range
40−-- to avoid inconsistency.
41−fileRange :: IndexedHeader -> IndexedHeader
42− -> H.Status -> H.ResponseHeaders
43− -> FilePath -> Maybe FilePart
38+-- If an application know the file size, it should be
39+-- specified using FilePart (Just).
40+-- If it is Nothing, disk access occurs to obtain its file size.
41+-- Content-Length and Content-Range (if necessary) are automatically
42+-- added into the HTTP response header.
43+-- If Content-Length and Content-Range exist in the HTTP response header,
44+-- they will cause consistency.
45+-- Status is also changed if necessary.
46+fileRange :: H.Status -> H.ResponseHeaders -> FilePath
47+ -> Maybe FilePart -> Maybe HeaderValue
4448 -> IO (Either SomeException
4549 (H.Status, H.ResponseHeaders, Integer, Integer))
46−fileRange reqidxhdr rspidxhdr s0 hs0 path mpart =
47− liftIO . try $ checkContentLength s0 hs0
50+fileRange s0 hs0 path mPart mRange = liftIO . try $ do
51+ fileSize <- checkFileSize mPart
52+ let (beg, end, len, isEntire) = checkPartRange fileSize mPart mRange
53+ let hs1 = addContentLength len hs0
54+ hs | isEntire = hs1
55+ | otherwise = addContentRange beg end fileSize hs1
56+ s | isEntire = s0
57+ | otherwise = H.status206
58+ return (s, hs, beg, len)
4859 where
49− mRange = reqidxhdr ! idxRange
50−
51− checkContentLength s' hdr' = do
52− (s, hdr, beg, len) <- checkMpart s' hdr' mpart
53− -- We respect Content-Length if exists.
54− -- The validity of Content-Length's value is Applications's
55− -- responsibility.
56− return (s, addContentLength rspidxhdr len hdr, beg, len)
57−
58− checkMpart s hdr Nothing = do
59− -- We don't know the size of the file.
60− -- Content-Length cannot help.
61− -- Let's obtain it first.
62− fileSize <- fromIntegral . P.fileSize <$> P.getFileStatus path
63− -- Then, let's manipulate Range in HTTP request.
64− return $ checkRange s hdr mRange fileSize
65− -- We respect Status.
66− -- The validity of Status's value is Applications's responsibility.
67− checkMpart s hdr (Just part) = return (s, hdr', beg, len)
60+ checkFileSize Nothing = fromIntegral . P.fileSize <$> P.getFileStatus path
61+ checkFileSize (Just part) = return $ filePartFileSize part
62+
63+checkPartRange :: Integer -> Maybe FilePart -> Maybe HeaderValue
64+ -> (Integer, Integer, Integer, Bool)
65+checkPartRange fileSize mPart mRange = checkPart mPart mRange
66+ where
67+ checkPart Nothing Nothing = (0, fileSize - 1, fileSize, True)
68+ checkPart Nothing (Just range) = case parseByteRanges range >>= listToMaybe of
69+ -- Range is broken
70+ Nothing -> (0, fileSize - 1, fileSize, True)
71+ Just hrange -> checkRange hrange
72+ -- Ignore Range if FilePart is specified
73+ checkPart (Just part) _ = (beg, end, len, isEntire)
6874 where
6975 beg = filePartOffset part
7076 len = filePartByteCount part
7177 end = beg + len - 1
72− fileSize = filePartFileSize part
73− hdr' = addContentRange rspidxhdr fileSize beg end hdr
74−
75− checkRange s hdr Nothing fileSize = (s, hdr, 0, fileSize)
76− checkRange s hdr (Just range) fileSize = case mhrange of
77− Nothing -> (s, hdr, 0, fileSize)
78− -- FIXME: original code checks if s is 200.
79− Just hrange -> case hrange of
80− H.ByteRangeFrom from -> fromRange hdr fileSize from (fileSize - 1)
81− H.ByteRangeFromTo from to -> fromRange hdr fileSize from to
82− H.ByteRangeSuffix count -> fromRange hdr fileSize (fileSize - count) (fileSize - 1)
83− where
84− mhrange = parseByteRanges range >>= listToMaybe
78+ isEntire = beg == 0 && len == fileSize
8579
86− fromRange hdr fileSize from to = (status, hdr', beg, len)
80+ checkRange (H.ByteRangeFrom beg) = fromRange beg (fileSize - 1)
81+ checkRange (H.ByteRangeFromTo beg end) = fromRange beg end
82+ checkRange (H.ByteRangeSuffix count) = fromRange (fileSize - count) (fileSize - 1)
83+
84+ fromRange beg end = (beg, end, len, isEntire)
8785 where
88− status = H.status206
89− hdr' = addContentRange rspidxhdr fileSize from to hdr
90− beg = from
91− len = to - from + 1
86+ len = end - beg + 1
87+ isEntire = beg == 0 && len == fileSize
9288
9389----------------------------------------------------------------
9490
@@ -102,12 +98,13 @@ sendResponse :: Connection
10298
10399----------------------------------------------------------------
104100
105−sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =
106− restore $ fileRange reqidxhdr rspidxhdr s0 hs path mpart >>= sendResponseEither
101+sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mPart) =
102+ restore $ fileRange s0 hs path mPart mRange >>= sendResponseEither
107103 where
108104 hs = addServer rspidxhdr $ addAcceptRanges hs0
109105 rspidxhdr = indexResponseHeader hs0
110106 th = threadHandle ii
107+ mRange = reqidxhdr ! idxRange
111108
112109 sendResponseEither (Right (s, lengthyHeaders, beg, len))
113110 | hasBody s req = liftIO $ do
@@ -260,34 +257,33 @@ addAcceptRanges hdrs = (hAcceptRanges, "bytes") : hdrs
260257addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders
261258addTransferEncoding hdrs = (hTransferEncoding, "chunked") : hdrs
262259
263−addContentLength :: IndexedHeader -> Integer -> H.ResponseHeaders -> H.ResponseHeaders
264−addContentLength rspidxhdr cl hdrs = case rspidxhdr ! idxContentLength of
265− Nothing -> (H.hContentLength, B.pack $ show cl) : hdrs
266− _ -> hdrs
267−
268−addServer :: IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
269−addServer rspidxhdr hdrs = case rspidxhdr ! idxServer of
270− Nothing -> (hServer, defaultServerValue) : hdrs
271− _ -> hdrs
260+addContentLength :: Integer -> H.ResponseHeaders -> H.ResponseHeaders
261+addContentLength cl hdrs = (H.hContentLength, len) : hdrs
262+ where
263+ len = B.pack $ show cl
272264
273−addContentRange :: IndexedHeader
274− -> Integer -> Integer -> Integer
265+addContentRange :: Integer -> Integer -> Integer
275266 -> H.ResponseHeaders -> H.ResponseHeaders
276−addContentRange rspidxhdr total from to hdrs = case rspidxhdr ! idxContentRange of
277− Nothing -> (hContentRange, range) : hdrs
278− _ -> hdrs
267+addContentRange beg end total hdrs = (hContentRange, range) : hdrs
279268 where
280269 range = B.pack
281270 -- building with ShowS
282271 $ 'b' : 'y': 't' : 'e' : 's' : ' '
283− : showInt from
272+ : showInt beg
284273 ( '-'
285− : showInt to
274+ : showInt end
286275 ( '/'
287276 : showInt total ""))
288277
289278----------------------------------------------------------------
290279
280+addServer :: IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders
281+addServer rspidxhdr hdrs = case rspidxhdr ! idxServer of
282+ Nothing -> (hServer, defaultServerValue) : hdrs
283+ _ -> hdrs
284+
285+----------------------------------------------------------------
286+
291287composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
292288composeHeaderBuilder ver s hs True =
293289 fromByteString <$> composeHeader ver s (addTransferEncoding hs)