0689eb3 · typeable/wai

git.iko.soy/typeable/wai

Wrote findBound

commit0689eb3352f9e29133ea97af9606c57239a752c4 authorMichael Snoyman <michael@snoyman.com> dateThu 20 May 2010, 20:50 (16 years ago) parente2e63ff

2 files changed+60−22

compare with master

unifiedsplit

Network/Wai/Parse.hs+27 runtests.hs+33−22

Network/Wai/Parse.hs+27

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12-- | Some helpers for parsing data out of a raw WAI 'Request'.

34module Network.Wai.Parse

@@ -9,6 +10,10 @@ module Network.Wai.Parse

910 , lbsSink

1011 , tempFileSink

1112 , FileInfo (..)

13+#if TEST

14+ , Bound (..)

15+ , findBound

16+#endif

1217 ) where

1318

1419import qualified Data.ByteString as S

@@ -254,3 +259,25 @@ parsePieces sink bound src isFirst = do

254259 in (x, S.dropWhile (== 32) y) -- space

255260

256261dropTillBound bound (bs, msrc) = error "FIXME dropTillBound"

262+

263+data Bound = FoundBound S.ByteString S.ByteString

264+ | NoBound

265+ | PartialBound

266+ deriving (Eq, Show)

267+

268+findBound :: S.ByteString -> S.ByteString -> Bound

269+findBound b bs = go [0..S.length bs - 1]

270+ where

271+ go [] = NoBound

272+ go (i:is)

273+ | mismatch [0..S.length b - 1] [i..S.length bs - 1] = go is

274+ | otherwise =

275+ let endI = i + S.length b

276+ in if endI > S.length bs

277+ then PartialBound

278+ else FoundBound (S.take i bs) (S.drop endI bs)

279+ mismatch [] _ = False

280+ mismatch _ [] = False

281+ mismatch (x:xs) (y:ys)

282+ | S.index b x == S.index bs y = mismatch xs ys

283+ | otherwise = True

runtests.hs+33−22

@@ -5,7 +5,7 @@ import Test.HUnit hiding (Test)

55import Network.Wai

66import Network.Wai.Parse

77import Network.Wai.Source

8−import qualified Data.ByteString.Char8 as B8

8+import qualified Data.ByteString.Char8 as S8

99import qualified Data.ByteString.Lazy.Char8 as L8

1010import Control.Arrow

1111

@@ -18,12 +18,13 @@ testSuite = testGroup "Network.Wai.Parse"

1818 , testCase "parseCookies" caseParseCookies

1919 , testCase "parseHttpAccept" caseParseHttpAccept

2020 , testCase "parseRequestBody" caseParseRequestBody

21+ , testCase "findBound" caseFindBound

2122 ]

2223

2324caseParseQueryString :: Assertion

2425caseParseQueryString = do

2526 let go l r =

26− map (B8.pack *** B8.pack) l @=? parseQueryString (B8.pack r)

27+ map (S8.pack *** S8.pack) l @=? parseQueryString (S8.pack r)

2728

2829 go [] ""

2930 go [("foo", "")] "foo"

@@ -38,20 +39,20 @@ caseParseQueryString = do

3839

3940caseParseCookies :: Assertion

4041caseParseCookies = do

41− let input = B8.pack "a=a1;b=b2; c=c3"

42+ let input = S8.pack "a=a1;b=b2; c=c3"

4243 expected = [("a", "a1"), ("b", "b2"), ("c", "c3")]

43− map (B8.pack *** B8.pack) expected @=? parseCookies input

44+ map (S8.pack *** S8.pack) expected @=? parseCookies input

4445

4546caseParseHttpAccept :: Assertion

4647caseParseHttpAccept = do

4748 let input =

48− B8.pack "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c"

49+ S8.pack "text/plain; q=0.5, text/html, text/x-dvi; q=0.8, text/x-c"

4950 expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]

50− map B8.pack expected @=? parseHttpAccept input

51+ map S8.pack expected @=? parseHttpAccept input

5152

5253caseParseRequestBody :: Assertion

5354caseParseRequestBody = t where

54− content2 = B8.pack $

55+ content2 = S8.pack $

5556 "--AaB03x\n" ++

5657 "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" ++

5758 "Content-Type: text/plain; charset=iso-8859-1\n\n" ++

@@ -67,35 +68,35 @@ caseParseRequestBody = t where

6768 "This is my file\n" ++

6869 "file test\n" ++

6970 "--AaB03x--"

70− content3 = B8.pack "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\nContent-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\nContent-Type: application/octet-stream\r\n\r\nPhoto blog using Hack.\n\r\n------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n"

71+ content3 = S8.pack "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\nContent-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\nContent-Type: application/octet-stream\r\n\r\nPhoto blog using Hack.\n\r\n------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n"

7172 t = do

72− let content1 = B8.pack "foo=bar&baz=bin"

73− let ctype1 = B8.pack "application/x-www-form-urlencoded"

73+ let content1 = S8.pack "foo=bar&baz=bin"

74+ let ctype1 = S8.pack "application/x-www-form-urlencoded"

7475 result1 <- parseRequestBody lbsSink $ toRequest ctype1 content1

7576 assertEqual "parsing post x-www-form-urlencoded"

76− (map (B8.pack *** B8.pack) [("foo", "bar"), ("baz", "bin")], [])

77+ (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], [])

7778 result1

7879 putStrLn "passed 1" -- FIXME remove

7980

80− let ctype2 = B8.pack "multipart/form-data; boundary=AaB03x"

81+ let ctype2 = S8.pack "multipart/form-data; boundary=AaB03x"

8182 result2 <- parseRequestBody lbsSink $ toRequest ctype2 content2

8283 let expectedsmap2 =

8384 [ ("title", "A File")

8485 , ("summary", "This is my file\nfile test")

8586 ]

8687 let expectedfile2 =

87− [(B8.pack "document", FileInfo (B8.pack "b.txt") (B8.pack "text/plain") $ L8.pack

88+ [(S8.pack "document", FileInfo (S8.pack "b.txt") (S8.pack "text/plain") $ L8.pack

8889 "This is a file.\nIt has two lines.")]

89− let expected2 = (map (B8.pack *** B8.pack) expectedsmap2, expectedfile2)

90+ let expected2 = (map (S8.pack *** S8.pack) expectedsmap2, expectedfile2)

9091 assertEqual "parsing post multipart/form-data"

9192 expected2

9293 result2

9394 putStrLn "passed 2" -- FIXME remove

9495

95− let ctype3 = B8.pack "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"

96+ let ctype3 = S8.pack "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"

9697 result3 <- parseRequestBody lbsSink $ toRequest ctype3 content3

9798 let expectedsmap3 = []

98− let expectedfile3 = [(B8.pack "yaml", FileInfo (B8.pack "README") (B8.pack "application/octet-stream") $

99+ let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $

99100 L8.pack "Photo blog using Hack.\n")]

100101 let expected3 = (expectedsmap3, expectedfile3)

101102 assertEqual "parsing actual post multipart/form-data"

@@ -116,7 +117,7 @@ caseParseRequestBody = t where

116117 result3'

117118 putStrLn "passed 5" -- FIXME remove

118119

119−toRequest :: B8.ByteString -> B8.ByteString -> Request

120+toRequest :: S8.ByteString -> S8.ByteString -> Request

120121toRequest ctype content = Request

121122 { requestHeaders = [(ReqContentType, ctype)]

122123 , requestBody = toSource content

@@ -131,7 +132,7 @@ toRequest ctype content = Request

131132 , remoteHost = undefined

132133 }

133134

134−toRequest' :: B8.ByteString -> B8.ByteString -> Request

135+toRequest' :: S8.ByteString -> S8.ByteString -> Request

135136toRequest' ctype content = Request

136137 { requestHeaders = [(ReqContentType, ctype)]

137138 , requestBody = toSource' content

@@ -146,11 +147,21 @@ toRequest' ctype content = Request

146147 , remoteHost = undefined

147148 }

148149

149−toSource :: B8.ByteString -> Source

150+toSource :: S8.ByteString -> Source

150151toSource bs = Source $

151− case B8.uncons bs of

152+ case S8.uncons bs of

152153 Nothing -> return Nothing

153− Just (x, xs) -> return $ Just (B8.singleton x, toSource xs)

154+ Just (x, xs) -> return $ Just (S8.singleton x, toSource xs)

154155

155−toSource' :: B8.ByteString -> Source

156+toSource' :: S8.ByteString -> Source

156157toSource' bs = Source $ return $ Just (bs, Source $ return Nothing)

158+

159+caseFindBound :: Assertion

160+caseFindBound = do

161+ findBound (S8.pack "def") (S8.pack "abcdefghi") @?=

162+ FoundBound (S8.pack "abc") (S8.pack "ghi")

163+ findBound (S8.pack "def") (S8.pack "ABC") @?= NoBound

164+ findBound (S8.pack "def") (S8.pack "abcd") @?= PartialBound

165+ findBound (S8.pack "def") (S8.pack "abcdE") @?= NoBound

166+ findBound (S8.pack "def") (S8.pack "abcdEdef") @?=

167+ FoundBound (S8.pack "abcdE") (S8.pack "")