@@ -25,7 +25,6 @@ import Network.HTTP.Attoparsec (parseByteRanges)
2525import qualified Network.HTTP.Types as H
2626import Network.Wai
2727import Network.Wai.Handler.Warp.Header
28−import Network.Wai.Handler.Warp.ReadInt
2928import qualified Network.Wai.Handler.Warp.ResponseHeader as RH
3029import qualified Network.Wai.Handler.Warp.Timeout as T
3130import Network.Wai.Handler.Warp.Types
@@ -35,47 +34,63 @@ import qualified System.PosixCompat.Files as P
3534
3635----------------------------------------------------------------
3736
38−fileRange :: IndexedHeader
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
3942 -> H.Status -> H.ResponseHeaders
4043 -> FilePath -> Maybe FilePart
4144 -> IO (Either SomeException
4245 (H.Status, H.ResponseHeaders, Integer, Integer))
43−fileRange reqidxhdr s0 hs0 path mpart0 = liftIO . try $ do
44− -- If mpart0 is not Nothing, Content-Range must exist.
45− (hadLength, total) <- handleLength
46− let (s, addRangeFunc, beg, len) = handleRange total
47− hs1 | hadLength = hs0
48− | otherwise = addContentLength len hs0
49− hs2 = addRangeFunc hs1
50− return (s, hs2, beg, len)
46+fileRange reqidxhdr rspidxhdr s0 hs0 path mpart = liftIO . try $
47+ tryContentLength s0 hs0
5148 where
52− -- 1) If Content-Length does not exist in HTTP response header,
53− -- we need to add it.
54− -- 2) Total length is necessary, anyway.
55− handleLength = case checkLength hs0 of
56− Just cl -> return (True, readInt cl)
57− Nothing -> case mpart0 of
58− Just part -> return (False, fromIntegral $ filePartByteCount part)
59− Nothing -> do
60− size <- fromIntegral . P.fileSize <$> P.getFileStatus path
61− return (False, size)
62− -- 1) Status. We should return 206 if partial.
63− -- 2) A function to add Content-Range.
64− -- 3) Offset.
65− -- 4) Length.
66− handleRange total = case mpart0 of
67− Just part -> (s0, id, filePartOffset part, filePartByteCount part)
68− Nothing -> case reqidxhdr ! idxRange >>= parseByteRanges >>= listToMaybe of
69− Just range | s0 == H.status200 -> case range of
70− H.ByteRangeFrom from -> fromRange total from (total - 1)
71− H.ByteRangeFromTo from to -> fromRange total from to
72− H.ByteRangeSuffix count -> fromRange total (total - count) (total - 1)
73− _ -> (s0, id, 0, total)
74−
75− fromRange total from to = (H.status206
76− ,addContentRange total from to
77− ,from
78− ,to - from + 1)
49+ mRange = reqidxhdr ! idxRange
50+ mContentLength = rspidxhdr ! idxContentLength
51+ mContentRange = rspidxhdr ! idxContentRange
52+
53+ tryContentLength s' hdr' = do
54+ quad@(s, hdr, beg, len) <- tryMpart s' hdr' mpart
55+ -- We respect Content-Length if exists.
56+ -- The validity of Content-Length's value is Applications's
57+ -- responsibility.
58+ case mContentLength of
59+ Nothing -> return (s, addContentLength len hdr, beg, len)
60+ _ -> return quad
61+
62+ tryMpart s hdr Nothing = do
63+ -- We don't know the size of the file.
64+ -- Content-Length cannot help.
65+ -- Let's obtain it first.
66+ fileSize <- fromIntegral . P.fileSize <$> P.getFileStatus path
67+ -- Then, let's manipulate Range in HTTP request.
68+ return $ tryRange s hdr mRange fileSize
69+ -- We respect Status.
70+ -- The validity of Status's value is Applications's responsibility.
71+ tryMpart s hdr (Just part) = return (s, hdr', beg, len)
72+ where
73+ beg = filePartOffset part
74+ len = filePartByteCount part
75+ hdr' = addRange mContentRange
76+ addRange Nothing = addContentRange len beg (beg + len - 1) hdr
77+ addRange _ = hdr
78+
79+ tryRange s hdr Nothing fileSize = (s, hdr, 0, fileSize)
80+ tryRange s hdr (Just range) fileSize = case mhrange of
81+ Nothing -> (s, hdr, 0, fileSize)
82+ -- FIXME: original code checks if s is 200.
83+ Just hrange -> case hrange of
84+ H.ByteRangeFrom from -> fromRange hdr fileSize from (fileSize - 1)
85+ H.ByteRangeFromTo from to -> fromRange hdr fileSize from to
86+ H.ByteRangeSuffix count -> fromRange hdr fileSize (fileSize - count) (fileSize - 1)
87+ where
88+ mhrange = parseByteRanges range >>= listToMaybe
89+
90+ fromRange hdr total from to = (H.status206
91+ ,addContentRange total from to hdr
92+ ,from
93+ ,to - from + 1)
7994
8095----------------------------------------------------------------
8196
@@ -89,11 +104,12 @@ sendResponse :: Connection
89104
90105----------------------------------------------------------------
91106
92−sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart0) =
93− restore $ fileRange reqidxhdr s0 hs path mpart0 >>= sendResponseEither
107+sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =
108+ restore $ fileRange reqidxhdr rspidxhdr s0 hs path mpart >>= sendResponseEither
94109 where
95110 hs = addAcceptRanges hs0
96111 th = threadHandle ii
112+ rspidxhdr = indexResponseHeader hs0
97113 sendResponseEither (Right (s, lengthyHeaders, beg, len))
98114 | hasBody s req = liftIO $ do
99115 lheader <- composeHeader version s lengthyHeaders