git.iko.soy/typeable/wai
on master help sign in
using http-type's parseByteRanges.
commitbef8cb486c893ea27e23c6fb8b55414b7e8d7c0b authorKazu Yamamoto <kazu@iij.ad.jp> dateTue 30 May 2017, 16:28 (9 years ago) parent9885aa9
3 files changed+7−64
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/File.hs+3−31 warp/Network/Wai/Handler/Warp/HTTP2/File.hs+3−32 warp/warp.cabal+1−1
warp/Network/Wai/Handler/Warp/File.hs+3−31
@@ -6,13 +6,12 @@ module Network.Wai.Handler.Warp.File (
66 RspFileInfo(..)
77 , conditionalRequest
88 , addContentHeadersForFilePart
9− , parseByteRanges
9+ , H.parseByteRanges
1010 ) where
1111
1212import Control.Applicative ((<|>))
1313import Data.Array ((!))
14−import qualified Data.ByteString as B hiding (pack)
15−import qualified Data.ByteString.Char8 as B (pack, readInteger)
14+import qualified Data.ByteString.Char8 as B (pack)
1615import Data.ByteString (ByteString)
1716import Data.Maybe (fromMaybe)
1817import Network.HTTP.Date
@@ -99,7 +98,7 @@ unconditional reqidx size = case reqidx ! fromEnum ReqRange of
9998----------------------------------------------------------------
10099
101100parseRange :: ByteString -> Integer -> RspFileInfo
102−parseRange rng size = case parseByteRanges rng of
101+parseRange rng size = case H.parseByteRanges rng of
103102 Nothing -> WithoutBody H.requestedRangeNotSatisfiable416
104103 Just [] -> WithoutBody H.requestedRangeNotSatisfiable416
105104 Just (r:_) -> let (!beg, !end) = checkRange r size
@@ -115,33 +114,6 @@ checkRange (H.ByteRangeFrom beg) size = (beg, size - 1)
115114checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size - 1) end)
116115checkRange (H.ByteRangeSuffix count) size = (max 0 (size - count), size - 1)
117116
118−-- | Parse the value of a Range header into a 'H.ByteRanges'.
119−parseByteRanges :: B.ByteString -> Maybe H.ByteRanges
120−parseByteRanges bs1 = do
121− bs2 <- stripPrefix "bytes=" bs1
122− (r, bs3) <- range bs2
123− ranges (r:) bs3
124− where
125− range bs2 = do
126− (i, bs3) <- B.readInteger bs2
127− if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")
128− then Just (H.ByteRangeSuffix (negate i), bs3)
129− else do
130− bs4 <- stripPrefix "-" bs3
131− case B.readInteger bs4 of
132− Just (j, bs5) | j >= i -> Just (H.ByteRangeFromTo i j, bs5)
133− _ -> Just (H.ByteRangeFrom i, bs4)
134− ranges front bs3
135− | B.null bs3 = Just (front [])
136− | otherwise = do
137− bs4 <- stripPrefix "," bs3
138− (r, bs5) <- range bs4
139− ranges (front . (r:)) bs5
140−
141− stripPrefix x y
142− | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)
143− | otherwise = Nothing
144−
145117----------------------------------------------------------------
146118
147119contentRange :: H.HeaderName
warp/Network/Wai/Handler/Warp/HTTP2/File.hs+3−32
@@ -6,12 +6,11 @@ module Network.Wai.Handler.Warp.HTTP2.File (
66 RspFileInfo(..)
77 , conditionalRequest
88 , addContentHeadersForFilePart
9− , parseByteRanges
9+ , H.parseByteRanges
1010 ) where
1111
1212import Control.Applicative ((<|>))
13−import qualified Data.ByteString as B hiding (pack)
14−import qualified Data.ByteString.Char8 as B (pack, readInteger)
13+import qualified Data.ByteString.Char8 as B (pack)
1514import Data.ByteString (ByteString)
1615import Data.Maybe (fromMaybe)
1716import Network.HTTP.Date
@@ -104,7 +103,7 @@ unconditional reqtbl size = case getHeaderValue tokenRange reqtbl of
104103
105104{-# INLINE parseRange #-}
106105parseRange :: ByteString -> Integer -> RspFileInfo
107−parseRange rng size = case parseByteRanges rng of
106+parseRange rng size = case H.parseByteRanges rng of
108107 Nothing -> WithoutBody H.requestedRangeNotSatisfiable416
109108 Just [] -> WithoutBody H.requestedRangeNotSatisfiable416
110109 Just (r:_) -> let (!beg, !end) = checkRange r size
@@ -121,34 +120,6 @@ checkRange (H.ByteRangeFrom beg) size = (beg, size - 1)
121120checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size - 1) end)
122121checkRange (H.ByteRangeSuffix count) size = (max 0 (size - count), size - 1)
123122
124−{-# INLINE parseByteRanges #-}
125−-- | Parse the value of a Range header into a 'H.ByteRanges'.
126−parseByteRanges :: B.ByteString -> Maybe H.ByteRanges
127−parseByteRanges bs1 = do
128− bs2 <- stripPrefix "bytes=" bs1
129− (r, bs3) <- range bs2
130− ranges (r:) bs3
131− where
132− range bs2 = do
133− (i, bs3) <- B.readInteger bs2
134− if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")
135− then Just (H.ByteRangeSuffix (negate i), bs3)
136− else do
137− bs4 <- stripPrefix "-" bs3
138− case B.readInteger bs4 of
139− Just (j, bs5) | j >= i -> Just (H.ByteRangeFromTo i j, bs5)
140− _ -> Just (H.ByteRangeFrom i, bs4)
141− ranges front bs3
142− | B.null bs3 = Just (front [])
143− | otherwise = do
144− bs4 <- stripPrefix "," bs3
145− (r, bs5) <- range bs4
146− ranges (front . (r:)) bs5
147−
148− stripPrefix x y
149− | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)
150− | otherwise = Nothing
151−
152123----------------------------------------------------------------
153124
154125{-# INLINE contentRangeHeader #-}
warp/warp.cabal+1−1
@@ -43,7 +43,7 @@ Library
4343 , case-insensitive >= 0.2
4444 , containers
4545 , ghc-prim
46− , http-types >= 0.8.5
46+ , http-types >= 0.9.1
4747 , iproute >= 1.3.1
4848 , http2 >= 1.6 && < 1.7
4949 , simple-sendfile >= 0.2.7 && < 0.3