@@ -1,7 +1,10 @@
11{-# LANGUAGE OverloadedStrings #-}
22{-# LANGUAGE BangPatterns #-}
33
4−module Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines) where
4+module Network.Wai.Handler.Warp.RequestHeader (
5+ parseHeaderLines
6+ , parseByteRanges
7+ ) where
58
69import Control.Exception (throwIO)
710import Control.Monad (when)
@@ -15,7 +18,9 @@ import Foreign.Ptr (Ptr, plusPtr, minusPtr, nullPtr)
1518import Foreign.Storable (peek)
1619import qualified Network.HTTP.Types as H
1720import Network.Wai.Handler.Warp.Types
18−
21+import qualified Network.HTTP.Types.Header as HH
22+import qualified Data.Attoparsec.ByteString.Char8 as A8
23+import Control.Applicative ((<|>), (<$>))
1924-- $setup
2025-- >>> :set -XOverloadedStrings
2126
@@ -149,3 +154,35 @@ parseHeader s =
149154 let (k, rest) = S.breakByte 58 s -- ':'
150155 rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
151156 in (CI.mk k, rest')
157+
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+
185+parseByteRanges :: S.ByteString -> Maybe HH.ByteRanges
186+parseByteRanges bs = case A8.parseOnly byteRangesParser bs of
187+ Left _ -> Nothing
188+ Right br -> Just br