git.iko.soy/typeable/wai
on master help sign in
Merge pull request #333 from dylex/master

Improve range handling to return 416

commitf3d601afcc27eae48053713262e888f1c2f6d219 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 4 Feb 2015, 16:11 (12 years ago) parent49a40e7d9cb4b7
3 files changed+38−31
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/RequestHeader.hs+13−15 warp/Network/Wai/Handler/Warp/Response.hs+12−9 warp/test/ResponseSpec.hs+13−7
warp/Network/Wai/Handler/Warp/RequestHeader.hs+13−15
@@ -137,23 +137,21 @@ parseByteRanges bs1 = do
137137 (r, bs3) <- range bs2
138138 ranges (r:) bs3
139139 where
140− range bs2 =
141− case stripPrefix "-" bs2 of
142− Just bs3 -> do
143− (i, bs4) <- B.readInteger bs3
144− Just (HH.ByteRangeSuffix i, bs4)
145− Nothing -> do
146− (i, bs3) <- B.readInteger bs2
140+ range bs2 = do
141+ (i, bs3) <- B.readInteger bs2
142+ if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")
143+ then Just (HH.ByteRangeSuffix (negate i), bs3)
144+ else do
147145 bs4 <- stripPrefix "-" bs3
148146 case B.readInteger bs4 of
149− Nothing -> Just (HH.ByteRangeFrom i, bs4)
150− Just (j, bs5) -> Just (HH.ByteRangeFromTo i j, bs5)
151− ranges front bs3 =
152− case stripPrefix "," bs3 of
153− Nothing -> Just (front [])
154− Just bs4 -> do
155− (r, bs5) <- range bs4
156− ranges (front . (r:)) bs5
147+ Just (j, bs5) | j >= i -> Just (HH.ByteRangeFromTo i j, bs5)
148+ _ -> Just (HH.ByteRangeFrom i, bs4)
149+ ranges front bs3
150+ | S.null bs3 = Just (front [])
151+ | otherwise = do
152+ bs4 <- stripPrefix "," bs3
153+ (r, bs5) <- range bs4
154+ ranges (front . (r:)) bs5
157155
158156 stripPrefix x y
159157 | x `S.isPrefixOf` y = Just (S.drop (S.length x) y)
warp/Network/Wai/Handler/Warp/Response.hs+12−9
@@ -30,9 +30,9 @@ import Data.Function (on)
3030import Data.List (deleteBy)
3131import Data.Maybe (isJust, listToMaybe)
3232#if MIN_VERSION_base(4,5,0)
33−import Data.Monoid ((<>))
33+import Data.Monoid ((<>), mempty)
3434#else
35−import Data.Monoid (mappend)
35+import Data.Monoid (mappend, mempty)
3636#endif
3737import Data.Version (showVersion)
3838import qualified Network.HTTP.Types as H
@@ -109,8 +109,8 @@ checkPartRange fileSize = checkPart
109109 isEntire = beg == 0 && len == fileSize
110110
111111 checkRange (H.ByteRangeFrom beg) = fromRange beg (fileSize - 1)
112− checkRange (H.ByteRangeFromTo beg end) = fromRange beg end
113− checkRange (H.ByteRangeSuffix count) = fromRange (fileSize - count) (fileSize - 1)
112+ checkRange (H.ByteRangeFromTo beg end) = fromRange beg (min (fileSize - 1) end)
113+ checkRange (H.ByteRangeSuffix count) = fromRange (max 0 (fileSize - count)) (fileSize - 1)
114114
115115 fromRange beg end = (beg, end, len, isEntire)
116116 where
@@ -225,9 +225,11 @@ sendRsp conn ver s0 hs0 (RspFile path mPart mRange hook) = do
225225 print _ex >>
226226#endif
227227 sendRsp conn ver s2 hs2 (RspBuilder body True)
228− Right (s, hs1, beg, len) -> do
228+ Right (s, hs1, beg, len) | len > 0 -> do
229229 lheader <- composeHeader ver s hs1
230230 connSendFile conn path beg len hook [lheader]
231+ | otherwise -> do
232+ sendRsp conn ver H.status416 hs1 (RspBuilder mempty True)
231233 where
232234 hs = addAcceptRanges hs0
233235 s2 = H.status404
@@ -373,11 +375,12 @@ addContentRange beg end total hdrs = (hContentRange, range) : hdrs
373375 range = B.pack
374376 -- building with ShowS
375377 $ 'b' : 'y': 't' : 'e' : 's' : ' '
376− : showInt beg
377− ( '-'
378− : showInt end
378+ : (if beg > end then ('*':) else
379+ (showInt beg)
380+ . ('-' :)
381+ . (showInt end))
379382 ( '/'
380− : showInt total ""))
383+ : showInt total "")
381384
382385addDate :: D.DateCache -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders
383386addDate dc rspidxhdr hdrs = case rspidxhdr ! idxDate of
warp/test/ResponseSpec.hs+13−7
@@ -19,7 +19,7 @@ main = hspec spec
1919
2020testRange :: S.ByteString -- ^ range value
2121 -> String -- ^ expected output
22− -> String -- ^ expected content-range value
22+ -> Maybe String -- ^ expected content-range value
2323 -> Spec
2424testRange range out crange = it title $ withApp defaultSettings app $ \port -> do
2525 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
@@ -31,9 +31,9 @@ testRange range out crange = it title $ withApp defaultSettings app $ \port -> d
3131 threadDelay 10000
3232 bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ S.hGetSome handle 1024
3333 hClose handle
34− out `shouldBe` last bss
34+ last bss `shouldBe` out
3535 let hs = mapMaybe toHeader bss
36− lookup "Content-Range" hs `shouldBe` Just ("bytes " ++ crange)
36+ lookup "Content-Range" hs `shouldBe` fmap ("bytes " ++) crange
3737 lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
3838 where
3939 app _ = ($ responseFile status200 [] "attic/hex" Nothing)
@@ -83,10 +83,12 @@ testFileRange desc s rsphdr file mPart mRange ans = it desc $ do
8383spec :: Spec
8484spec = do
8585 describe "range requests" $ do
86− testRange "2-3" "23" "2-3/16"
87− testRange "5-" "56789abcdef" "5-15/16"
88− testRange "5-8" "5678" "5-8/16"
89− testRange "-3" "def" "13-15/16"
86+ testRange "2-3" "23" $ Just "2-3/16"
87+ testRange "5-" "56789abcdef" $ Just "5-15/16"
88+ testRange "5-8" "5678" $ Just "5-8/16"
89+ testRange "-3" "def" $ Just "13-15/16"
90+ testRange "16-" "" $ Just "*/16"
91+ testRange "-17" "0123456789abcdef" Nothing
9092
9193 describe "partial files" $ do
9294 testPartial 16 2 2 "23"
@@ -114,6 +116,10 @@ spec = do
114116 "gets a file size from file system and handles Range and returns Partical Content"
115117 status200 [] "attic/hex" Nothing (Just "bytes=2-14")
116118 $ Right (status206,[("Content-Range","bytes 2-14/16"),("Content-Length","13")],2,13)
119+ testFileRange
120+ "truncates end point of range to file size"
121+ status200 [] "attic/hex" Nothing (Just "bytes=10-20")
122+ $ Right (status206,[("Content-Range","bytes 10-15/16"),("Content-Length","6")],10,6)
117123 testFileRange
118124 "gets a file size from file system and handles Range and returns OK if Range means the entire"
119125 status200 [] "attic/hex" Nothing (Just "bytes=0-15")