@@ -9,7 +9,7 @@ module Network.Wai.Handler.Warp.RequestHeader (
99import Control.Exception (throwIO)
1010import Control.Monad (when)
1111import qualified Data.ByteString as S
12−import qualified Data.ByteString.Char8 as B (unpack)
12+import qualified Data.ByteString.Char8 as B (unpack, readInteger)
1313import Data.ByteString.Internal (ByteString(..), memchr)
1414import qualified Data.CaseInsensitive as CI
1515import Data.Word (Word8)
@@ -19,8 +19,6 @@ import Foreign.Storable (peek)
1919import qualified Network.HTTP.Types as H
2020import Network.Wai.Handler.Warp.Types
2121import qualified Network.HTTP.Types.Header as HH
22−import qualified Data.Attoparsec.ByteString.Char8 as A8
23−import Control.Applicative ((<|>), (<$>))
2422-- $setup
2523-- >>> :set -XOverloadedStrings
2624
@@ -155,34 +153,30 @@ parseHeader s =
155153 rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
156154 in (CI.mk k, rest')
157155
158−byteRangesParser :: A8.Parser HH.ByteRanges
159−byteRangesParser = do
160− _ <- A8.string "bytes="
161− br <- range
162− rest <- maybeMoreRanges
163− return $ br:rest
164− where
165− range = rangeFromTo <|> rangeSuffix
166− rangeFromTo = do
167− f <- A8.decimal
168− _ <- A8.char '-'
169− mt <- Just <$> A8.decimal <|> return Nothing
170−
171− return $ case mt of
172− Just t -> HH.ByteRangeFromTo f t
173− Nothing -> HH.ByteRangeFrom f
174− rangeSuffix = do
175− _ <- A8.char '-'
176− s <- A8.decimal
177− return $ HH.ByteRangeSuffix s
178− maybeMoreRanges = moreRanges <|> return []
179− moreRanges = do
180− _ <- A8.char ','
181− r <- range
182− rest <- maybeMoreRanges
183− return $ r:rest
184−
185156parseByteRanges :: S.ByteString -> Maybe HH.ByteRanges
186−parseByteRanges bs = case A8.parseOnly byteRangesParser bs of
187− Left _ -> Nothing
188− Right br -> Just br
157+parseByteRanges bs1 = do
158+ bs2 <- stripPrefix "bytes=" bs1
159+ (r, bs3) <- range bs2
160+ ranges (r:) bs3
161+ where
162+ range bs2 =
163+ case stripPrefix "-" bs2 of
164+ Just bs3 -> do
165+ (i, bs4) <- B.readInteger bs3
166+ Just (HH.ByteRangeSuffix i, bs4)
167+ Nothing -> do
168+ (i, bs3) <- B.readInteger bs2
169+ bs4 <- stripPrefix "-" bs3
170+ case B.readInteger bs4 of
171+ Nothing -> Just (HH.ByteRangeFrom i, bs4)
172+ Just (j, bs5) -> Just (HH.ByteRangeFromTo i j, bs5)
173+ ranges front bs3 =
174+ case stripPrefix "," bs3 of
175+ Nothing -> Just (front [])
176+ Just bs4 -> do
177+ (r, bs5) <- range bs4
178+ ranges (front . (r:)) bs5
179+
180+ stripPrefix x y
181+ | x `S.isPrefixOf` y = Just (S.drop (S.length x) y)
182+ | otherwise = Nothing