git.iko.soy/typeable/wai
on master help sign in
Merge remote-tracking branch 'origin/master' into beta
c057210Michael Snoyman
wai-extra/Network/Wai/Parse.hs+9−30
compare with master
unifiedsplit
@@ -25,11 +25,11 @@ module Network.Wai.Parse
25#endif
25#endif
26 ) where
26 ) where
27
27
28+import qualified Data.ByteString.Search as Search
28import qualified Data.ByteString as S
29import qualified Data.ByteString as S
29import qualified Data.ByteString.Lazy as L
30import qualified Data.ByteString.Lazy as L
30import qualified Data.ByteString.Char8 as S8
31import qualified Data.ByteString.Char8 as S8
31import Data.Word (Word8)
32import Data.Word (Word8)
32−import Data.Bits
33import Data.Maybe (fromMaybe)
33import Data.Maybe (fromMaybe)
34import Data.List (sortBy)
34import Data.List (sortBy)
35import Data.Function (on)
35import Data.Function (on)
@@ -46,38 +46,11 @@ import Control.Monad (when, unless)
46import Control.Monad.Trans.Class (lift)
46import Control.Monad.Trans.Class (lift)
47import Control.Monad.Trans.Resource (allocate, release, register)
47import Control.Monad.Trans.Resource (allocate, release, register)
48
48
49−uncons :: S.ByteString -> Maybe (Word8, S.ByteString)
50−uncons s
51− | S.null s = Nothing
52− | otherwise = Just (S.head s, S.tail s)
53−
54breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
49breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
55breakDiscard w s =
50breakDiscard w s =
56 let (x, y) = S.break (== w) s
51 let (x, y) = S.break (== w) s
57 in (x, S.drop 1 y)
52 in (x, S.drop 1 y)
58
53
59−qsDecode :: S.ByteString -> S.ByteString
60−qsDecode z = fst $ S.unfoldrN (S.length z) go z
61− where
62− go bs =
63− case uncons bs of
64− Nothing -> Nothing
65− Just (43, ws) -> Just (32, ws) -- plus to space
66− Just (37, ws) -> Just $ fromMaybe (37, ws) $ do -- percent
67− (x, xs) <- uncons ws
68− x' <- hexVal x
69− (y, ys) <- uncons xs
70− y' <- hexVal y
71− Just $ (combine x' y', ys)
72− Just (w, ws) -> Just (w, ws)
73− hexVal w
74− | 48 <= w && w <= 57 = Just $ w - 48 -- 0 - 9
75− | 65 <= w && w <= 70 = Just $ w - 55 -- A - F
76− | 97 <= w && w <= 102 = Just $ w - 87 -- a - f
77− | otherwise = Nothing
78− combine :: Word8 -> Word8 -> Word8
79− combine a b = shiftL a 4 .|. b
80−
81-- | Parse the HTTP accept string to determine supported content types.
54-- | Parse the HTTP accept string to determine supported content types.
82parseHttpAccept :: S.ByteString -> [S.ByteString]
55parseHttpAccept :: S.ByteString -> [S.ByteString]
83parseHttpAccept = map fst
56parseHttpAccept = map fst
@@ -226,7 +199,7 @@ parsePieces sink bound =
226 let iter front bs = return $ front . (:) bs
199 let iter front bs = return $ front . (:) bs
227 (wasFound, front) <- sinkTillBound bound iter seed
200 (wasFound, front) <- sinkTillBound bound iter seed
228 let bs = S.concat $ front []
201 let bs = S.concat $ front []
229− let x' = (name, qsDecode bs)
202+ let x' = (name, bs)
230 yield $ Left x'
203 yield $ Left x'
231 when wasFound loop
204 when wasFound loop
232 _ -> do
205 _ -> do
@@ -248,8 +221,14 @@ data Bound = FoundBound S.ByteString S.ByteString
248 deriving (Eq, Show)
221 deriving (Eq, Show)
249
222
250findBound :: S.ByteString -> S.ByteString -> Bound
223findBound :: S.ByteString -> S.ByteString -> Bound
251−findBound b bs = go [0..S.length bs - 1]
224+findBound b bs = handleBreak $ Search.breakOn b bs
252 where
225 where
226+ handleBreak (h, t)
227+ | S.null t = go [lowBound..S.length bs - 1]
228+ | otherwise = FoundBound h $ S.drop (S.length b) t
229+
230+ lowBound = max 0 $ S.length bs - S.length b
231+
253 go [] = NoBound
232 go [] = NoBound
254 go (i:is)
233 go (i:is)
255 | mismatch [0..S.length b - 1] [i..S.length bs - 1] = go is
234 | mismatch [0..S.length b - 1] [i..S.length bs - 1] = go is
wai-extra/test/WaiExtraTest.hs+24−1
@@ -33,13 +33,15 @@ import Control.Monad.IO.Class (liftIO)
33import Data.Maybe (fromMaybe)
33import Data.Maybe (fromMaybe)
34import Network.HTTP.Types (parseSimpleQuery, status200)
34import Network.HTTP.Types (parseSimpleQuery, status200)
35
35
36−specs :: Specs
36+specs :: Spec
37specs = do
37specs = do
38 describe "Network.Wai.Parse" $ do
38 describe "Network.Wai.Parse" $ do
39 it "parseQueryString" caseParseQueryString
39 it "parseQueryString" caseParseQueryString
40 it "parseQueryString with question mark" caseParseQueryStringQM
40 it "parseQueryString with question mark" caseParseQueryStringQM
41 it "parseHttpAccept" caseParseHttpAccept
41 it "parseHttpAccept" caseParseHttpAccept
42 it "parseRequestBody" caseParseRequestBody
42 it "parseRequestBody" caseParseRequestBody
43+ it "multipart with plus" caseMultipartPlus
44+ it "urlencoded with plus" caseUrlEncPlus
43 {-
45 {-
44 , it "findBound" caseFindBound
46 , it "findBound" caseFindBound
45 , it "sinkTillBound" caseSinkTillBound
47 , it "sinkTillBound" caseSinkTillBound
@@ -169,6 +171,27 @@ caseParseRequestBody =
169 expected3
171 expected3
170 result3'
172 result3'
171
173
174+caseMultipartPlus :: Assertion
175+caseMultipartPlus = do
176+ result <- C.runResourceT $ parseRequestBody' lbsSink $ toRequest ctype content
177+ liftIO $ result @?= ([("email", "has+plus")], [])
178+ where
179+ content = S8.pack $
180+ "--AaB03x\n" ++
181+ "Content-Disposition: form-data; name=\"email\"\n" ++
182+ "Content-Type: text/plain; charset=iso-8859-1\n\n" ++
183+ "has+plus\n" ++
184+ "--AaB03x--"
185+ ctype = "multipart/form-data; boundary=AaB03x"
186+
187+caseUrlEncPlus :: Assertion
188+caseUrlEncPlus = do
189+ result <- C.runResourceT $ parseRequestBody' lbsSink $ toRequest ctype content
190+ liftIO $ result @?= ([("email", "has+plus")], [])
191+ where
192+ content = S8.pack $ "email=has%2Bplus"
193+ ctype = "application/x-www-form-urlencoded"
194+
172toRequest :: S8.ByteString -> S8.ByteString -> SRequest
195toRequest :: S8.ByteString -> S8.ByteString -> SRequest
173toRequest ctype content = SRequest defaultRequest
196toRequest ctype content = SRequest defaultRequest
174 { requestHeaders = [("Content-Type", ctype)]
197 { requestHeaders = [("Content-Type", ctype)]
wai-extra/tests.hs+1−1
@@ -2,4 +2,4 @@ import Test.Hspec.Monadic
2import qualified WaiExtraTest
2import qualified WaiExtraTest
3
3
4main :: IO ()
4main :: IO ()
5−main = hspecX WaiExtraTest.specs
5+main = hspec WaiExtraTest.specs
wai-extra/wai-extra.cabal+2−1
@@ -40,6 +40,7 @@ Library
40 , ansi-terminal
40 , ansi-terminal
41 , resourcet >= 0.3 && < 0.4
41 , resourcet >= 0.3 && < 0.4
42 , void >= 0.5 && < 0.6
42 , void >= 0.5 && < 0.6
43+ , stringsearch >= 0.3 && < 0.4
43
44
44 Exposed-modules: Network.Wai.Handler.CGI
45 Exposed-modules: Network.Wai.Handler.CGI
45 Network.Wai.Middleware.AcceptOverride
46 Network.Wai.Middleware.AcceptOverride
@@ -73,7 +74,7 @@ test-suite tests
73 , zlib
74 , zlib
74 , text
75 , text
75 , bytestring
76 , bytestring
76− , directory
77+ , directory
77 , zlib-bindings
78 , zlib-bindings
78 , blaze-builder >= 0.2.1.4 && < 0.4
79 , blaze-builder >= 0.2.1.4 && < 0.4
79 , data-default
80 , data-default