warp 2.0.2 → 2.0.2.1
raw patch · 4 files changed
+54/−8 lines, 4 filesdep −http-attoparsec
Dependencies removed: http-attoparsec
Files
- Network/Wai/Handler/Warp/RequestHeader.hs +34/−3
- Network/Wai/Handler/Warp/Response.hs +1/−1
- test/RequestSpec.hs +18/−1
- warp.cabal +1/−3
Network/Wai/Handler/Warp/RequestHeader.hs view
@@ -1,12 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-} -module Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines) where+module Network.Wai.Handler.Warp.RequestHeader (+ parseHeaderLines+ , parseByteRanges+ ) where import Control.Exception (throwIO) import Control.Monad (when) import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as B (unpack)+import qualified Data.ByteString.Char8 as B (unpack, readInteger) import Data.ByteString.Internal (ByteString(..), memchr) import qualified Data.CaseInsensitive as CI import Data.Word (Word8)@@ -15,7 +18,7 @@ import Foreign.Storable (peek) import qualified Network.HTTP.Types as H import Network.Wai.Handler.Warp.Types-+import qualified Network.HTTP.Types.Header as HH -- $setup -- >>> :set -XOverloadedStrings @@ -149,3 +152,31 @@ let (k, rest) = S.breakByte 58 s -- ':' rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest in (CI.mk k, rest')++parseByteRanges :: S.ByteString -> Maybe HH.ByteRanges+parseByteRanges bs1 = do+ bs2 <- stripPrefix "bytes=" bs1+ (r, bs3) <- range bs2+ ranges (r:) bs3+ where+ range bs2 =+ case stripPrefix "-" bs2 of+ Just bs3 -> do+ (i, bs4) <- B.readInteger bs3+ Just (HH.ByteRangeSuffix i, bs4)+ Nothing -> do+ (i, bs3) <- B.readInteger bs2+ bs4 <- stripPrefix "-" bs3+ case B.readInteger bs4 of+ Nothing -> Just (HH.ByteRangeFrom i, bs4)+ Just (j, bs5) -> Just (HH.ByteRangeFromTo i j, bs5)+ ranges front bs3 =+ case stripPrefix "," bs3 of+ Nothing -> Just (front [])+ Just bs4 -> do+ (r, bs5) <- range bs4+ ranges (front . (r:)) bs5++ stripPrefix x y+ | x `S.isPrefixOf` y = Just (S.drop (S.length x) y)+ | otherwise = Nothing
Network/Wai/Handler/Warp/Response.hs view
@@ -31,7 +31,6 @@ import Data.Monoid (mappend) #endif import Data.Version (showVersion)-import Network.HTTP.Attoparsec (parseByteRanges) import qualified Network.HTTP.Types as H import Network.Wai import qualified Network.Wai.Handler.Warp.Date as D@@ -39,6 +38,7 @@ import Network.Wai.Handler.Warp.Buffer (toBlazeBuffer) import Network.Wai.Handler.Warp.IO (toBufIOWith) import Network.Wai.Handler.Warp.ResponseHeader+import Network.Wai.Handler.Warp.RequestHeader (parseByteRanges) import qualified Network.Wai.Handler.Warp.Timeout as T import Network.Wai.Handler.Warp.Types import Network.Wai.Internal
test/RequestSpec.hs view
@@ -1,18 +1,27 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-} module RequestSpec (main, spec) where import Data.Conduit import Data.Conduit.List import Network.Wai.Handler.Warp.Request+import Network.Wai.Handler.Warp.RequestHeader (parseByteRanges) import Network.Wai.Handler.Warp.Types import Test.Hspec+import qualified Data.ByteString.Char8 as S8+import qualified Network.HTTP.Types.Header as HH +deriving instance Show HH.ByteRange+deriving instance Eq HH.ByteRange+ main :: IO () main = hspec spec spec :: Spec-spec = describe "headerLines" $ do+spec = do+ describe "headerLines" $ do it "takes until blank" $ blankSafe >>= (`shouldBe` ["foo", "bar", "baz"]) it "ignored leading whitespace in bodies" $@@ -21,6 +30,14 @@ tooMany `shouldThrow` overLargeHeader it "throws OverLargeHeader when too large" $ tooLarge `shouldThrow` overLargeHeader+ describe "parseByteRanges" $ do+ let test x y = it x $ parseByteRanges (S8.pack x) `shouldBe` y+ test "bytes=0-499" $ Just [HH.ByteRangeFromTo 0 499]+ test "bytes=500-999" $ Just [HH.ByteRangeFromTo 500 999]+ test "bytes=-500" $ Just [HH.ByteRangeSuffix 500]+ test "bytes=9500-" $ Just [HH.ByteRangeFrom 9500]+ test "foobytes=9500-" Nothing+ test "bytes=0-0,-1" $ Just [HH.ByteRangeFromTo 0 0, HH.ByteRangeSuffix 1] where blankSafe = (sourceList ["f", "oo\n", "bar\nbaz\n\r\n"]) $$ headerLines whiteSafe = (sourceList ["foo\r\nbar\r\nbaz\r\n\r\n hi there"]) $$ headerLines
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 2.0.2+Version: 2.0.2.1 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -46,7 +46,6 @@ , unix-compat >= 0.2 , void , wai >= 2.0 && < 2.1- , http-attoparsec if flag(network-bytestring) Build-Depends: network >= 2.2.1.5 && < 2.2.3 , network-bytestring >= 0.1.3 && < 0.1.4@@ -127,7 +126,6 @@ , unix-compat >= 0.2 , void , wai >= 2.0 && < 2.1- , http-attoparsec , network , HUnit , QuickCheck