wai-extra 1.2.0.4 → 1.2.0.5

raw patch · 3 files changed

+35/−32 lines, 3 filesdep +stringsearchnew-uploader

Dependencies added: stringsearch

Files

• Network/Wai/Parse.hs +9/−30
• test/WaiExtraTest.hs +23/−0
• wai-extra.cabal +3/−2

@@ -29,11 +29,11 @@ #endif     ) where +import qualified Data.ByteString.Search as Search import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Char8 as S8 import Data.Word (Word8)-import Data.Bits import Data.Maybe (fromMaybe) import Data.List (sortBy) import Data.Function (on)@@ -46,38 +46,11 @@ import qualified Network.HTTP.Types as H import Data.Either (partitionEithers) -uncons :: S.ByteString -> Maybe (Word8, S.ByteString)-uncons s-    | S.null s = Nothing-    | otherwise = Just (S.head s, S.tail s)- breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString) breakDiscard w s =     let (x, y) = S.break (== w) s      in (x, S.drop 1 y) -qsDecode :: S.ByteString -> S.ByteString-qsDecode z = fst $ S.unfoldrN (S.length z) go z-  where-    go bs =-        case uncons bs of-            Nothing -> Nothing-            Just (43, ws) -> Just (32, ws) -- plus to space-            Just (37, ws) -> Just $ fromMaybe (37, ws) $ do -- percent-                (x, xs) <- uncons ws-                x' <- hexVal x-                (y, ys) <- uncons xs-                y' <- hexVal y-                Just $ (combine x' y', ys)-            Just (w, ws) -> Just (w, ws)-    hexVal w-        | 48 <= w && w <= 57  = Just $ w - 48 -- 0 - 9-        | 65 <= w && w <= 70  = Just $ w - 55 -- A - F-        | 97 <= w && w <= 102 = Just $ w - 87 -- a - f-        | otherwise = Nothing-    combine :: Word8 -> Word8 -> Word8-    combine a b = shiftL a 4 .|. b- -- | Parse the HTTP accept string to determine supported content types. parseHttpAccept :: S.ByteString -> [S.ByteString] parseHttpAccept = map fst@@ -259,7 +232,7 @@                     (front, wasFound) <-                         sinkTillBound bound iter seed                     let bs = S.concat $ front []-                    let x' = (name, qsDecode bs)+                    let x' = (name, bs)                     return $ C.Emit wasFound [Left x']                 _ -> do                     -- ignore this part@@ -280,8 +253,14 @@     deriving (Eq, Show)  findBound :: S.ByteString -> S.ByteString -> Bound-findBound b bs = go [0..S.length bs - 1]+findBound b bs = handleBreak $ Search.breakOn b bs   where+    handleBreak (h, t)+        | S.null t = go [lowBound..S.length bs - 1]+        | otherwise = FoundBound h $ S.drop (S.length b) t++    lowBound = max 0 $ S.length bs - S.length b+     go [] = NoBound     go (i:is)         | mismatch [0..S.length b - 1] [i..S.length bs - 1] = go is

@@ -40,6 +40,8 @@     it "parseQueryString with question mark" caseParseQueryStringQM     it "parseHttpAccept" caseParseHttpAccept     it "parseRequestBody" caseParseRequestBody+    it "multipart with plus" caseMultipartPlus+    it "urlencoded with plus" caseUrlEncPlus     {-     , it "findBound" caseFindBound     , it "sinkTillBound" caseSinkTillBound@@ -168,6 +170,27 @@         liftIO $ assertEqual "parsing actual post multipart/form-data 2"                     expected3                     result3'++caseMultipartPlus :: Assertion+caseMultipartPlus = do+    result <- C.runResourceT $ parseRequestBody' lbsBackEnd $ toRequest ctype content+    liftIO $ result @?= ([("email", "has+plus")], [])+  where+    content = S8.pack $+        "--AaB03x\n" +++        "Content-Disposition: form-data; name=\"email\"\n" +++        "Content-Type: text/plain; charset=iso-8859-1\n\n" +++        "has+plus\n" +++        "--AaB03x--"+    ctype = "multipart/form-data; boundary=AaB03x"++caseUrlEncPlus :: Assertion+caseUrlEncPlus = do+    result <- C.runResourceT $ parseRequestBody' lbsBackEnd $ toRequest ctype content+    liftIO $ result @?= ([("email", "has+plus")], [])+  where+    content = S8.pack $ "email=has%2Bplus"+    ctype = "application/x-www-form-urlencoded"  toRequest :: S8.ByteString -> S8.ByteString -> SRequest toRequest ctype content = SRequest defaultRequest

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             1.2.0.4+Version:             1.2.0.5 Synopsis:            Provides some basic WAI handlers and middleware. Description:         The goal here is to provide common features without many dependencies. License:             MIT@@ -39,6 +39,7 @@                    , blaze-builder-conduit     >= 0.4      && < 0.5                    , ansi-terminal                    , resourcet                 >= 0.3      && < 0.4+                   , stringsearch              >= 0.3      && < 0.4    Exposed-modules:   Network.Wai.Handler.CGI                      Network.Wai.Middleware.AcceptOverride@@ -72,7 +73,7 @@                    , zlib                    , text                    , bytestring-                   , directory +                   , directory                    , zlib-bindings                    , blaze-builder             >= 0.2.1.4  && < 0.4                    , data-default