d792c31 · typeable/wai

25import qualified Network.HTTP.Types as H

26import Network.Wai

27import Network.Wai.Handler.Warp.Header

28−import Network.Wai.Handler.Warp.ReadInt

29import qualified Network.Wai.Handler.Warp.ResponseHeader as RH

28import qualified Network.Wai.Handler.Warp.ResponseHeader as RH

30import qualified Network.Wai.Handler.Warp.Timeout as T

29import qualified Network.Wai.Handler.Warp.Timeout as T

31import Network.Wai.Handler.Warp.Types

30import Network.Wai.Handler.Warp.Types

35

34

36----------------------------------------------------------------

35----------------------------------------------------------------

37

36

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.

38−fileRange :: IndexedHeader

41+fileRange :: IndexedHeader -> IndexedHeader

39 -> H.Status -> H.ResponseHeaders

42 -> H.Status -> H.ResponseHeaders

40 -> FilePath -> Maybe FilePart

43 -> FilePath -> Maybe FilePart

41 -> IO (Either SomeException

44 -> IO (Either SomeException

42 (H.Status, H.ResponseHeaders, Integer, Integer))

45 (H.Status, H.ResponseHeaders, Integer, Integer))

43−fileRange reqidxhdr s0 hs0 path mpart0 = liftIO . try $ do

46+fileRange reqidxhdr rspidxhdr s0 hs0 path mpart = liftIO . try $

44− -- If mpart0 is not Nothing, Content-Range must exist.

47+ tryContentLength s0 hs0

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)

51 where

48 where

52− -- 1) If Content-Length does not exist in HTTP response header,

49+ mRange = reqidxhdr ! idxRange

53− -- we need to add it.

50+ mContentLength = rspidxhdr ! idxContentLength

54− -- 2) Total length is necessary, anyway.

51+ mContentRange = rspidxhdr ! idxContentRange

55− handleLength = case checkLength hs0 of

52+

56− Just cl -> return (True, readInt cl)

53+ tryContentLength s' hdr' = do

57− Nothing -> case mpart0 of

54+ quad@(s, hdr, beg, len) <- tryMpart s' hdr' mpart

58− Just part -> return (False, fromIntegral $ filePartByteCount part)

55+ -- We respect Content-Length if exists.

59− Nothing -> do

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.

60− size <- fromIntegral . P.fileSize <$> P.getFileStatus path

66+ fileSize <- fromIntegral . P.fileSize <$> P.getFileStatus path

61− return (False, size)

67+ -- Then, let's manipulate Range in HTTP request.

62− -- 1) Status. We should return 206 if partial.

68+ return $ tryRange s hdr mRange fileSize

63− -- 2) A function to add Content-Range.

69+ -- We respect Status.

64− -- 3) Offset.

70+ -- The validity of Status's value is Applications's responsibility.

65− -- 4) Length.

71+ tryMpart s hdr (Just part) = return (s, hdr', beg, len)

66− handleRange total = case mpart0 of

72+ where

73+ beg = filePartOffset part

67− Just part -> (s0, id, filePartOffset part, filePartByteCount part)

74+ len = filePartByteCount part

68− Nothing -> case reqidxhdr ! idxRange >>= parseByteRanges >>= listToMaybe of

75+ hdr' = addRange mContentRange

69− Just range | s0 == H.status200 -> case range of

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

70− H.ByteRangeFrom from -> fromRange total from (total - 1)

84+ H.ByteRangeFrom from -> fromRange hdr fileSize from (fileSize - 1)

71− H.ByteRangeFromTo from to -> fromRange total from to

85+ H.ByteRangeFromTo from to -> fromRange hdr fileSize from to

72− H.ByteRangeSuffix count -> fromRange total (total - count) (total - 1)

86+ H.ByteRangeSuffix count -> fromRange hdr fileSize (fileSize - count) (fileSize - 1)

73− _ -> (s0, id, 0, total)

87+ where

74−

88+ mhrange = parseByteRanges range >>= listToMaybe

89+

75− fromRange total from to = (H.status206

90+ fromRange hdr total from to = (H.status206

76− ,addContentRange total from to

91+ ,addContentRange total from to hdr

77− ,from

92+ ,from

78− ,to - from + 1)

93+ ,to - from + 1)

79

94

80----------------------------------------------------------------

95----------------------------------------------------------------

81

96

89

104

90----------------------------------------------------------------

105----------------------------------------------------------------

91

106

92−sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart0) =

107+sendResponse conn ii restore req reqidxhdr (ResponseFile s0 hs0 path mpart) =

93− restore $ fileRange reqidxhdr s0 hs path mpart0 >>= sendResponseEither

108+ restore $ fileRange reqidxhdr rspidxhdr s0 hs path mpart >>= sendResponseEither

94 where

109 where

95 hs = addAcceptRanges hs0

110 hs = addAcceptRanges hs0

96 th = threadHandle ii

111 th = threadHandle ii

112+ rspidxhdr = indexResponseHeader hs0

97 sendResponseEither (Right (s, lengthyHeaders, beg, len))

113 sendResponseEither (Right (s, lengthyHeaders, beg, len))

98 | hasBody s req = liftIO $ do

114 | hasBody s req = liftIO $ do

99 lheader <- composeHeader version s lengthyHeaders

115 lheader <- composeHeader version s lengthyHeaders