0689eb3 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Wrote findBound

0689eb3Michael Snoyman16 years ago

Network/Wai/Parse.hs+27

compare with master

unifiedsplit

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

1+{-# LANGUAGE CPP #-}

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

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

3module Network.Wai.Parse

4module Network.Wai.Parse

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

9 , lbsSink

10 , lbsSink

10 , tempFileSink

11 , tempFileSink

11 , FileInfo (..)

12 , FileInfo (..)

13+#if TEST

14+ , Bound (..)

15+ , findBound

16+#endif

12 ) where

17 ) where

14import qualified Data.ByteString as S

19import qualified Data.ByteString as S

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

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

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

255

260

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

261dropTillBound 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)

5import Network.Wai

6import Network.Wai.Parse

7import Network.Wai.Source

8−import qualified Data.ByteString.Char8 as B8

8+import qualified Data.ByteString.Char8 as S8

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

10import Control.Arrow

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

18 , testCase "parseCookies" caseParseCookies

19 , testCase "parseHttpAccept" caseParseHttpAccept

20 , testCase "parseRequestBody" caseParseRequestBody

21+ , testCase "findBound" caseFindBound

21 ]

22 ]

23caseParseQueryString :: Assertion

24caseParseQueryString :: Assertion

24caseParseQueryString = do

25caseParseQueryString = do

25 let go l r =

26 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)

28 go [] ""

29 go [] ""

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

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

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

39caseParseCookies :: Assertion

40caseParseCookies :: Assertion

40caseParseCookies = do

41caseParseCookies = do

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

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

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

43 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

45caseParseHttpAccept :: Assertion

46caseParseHttpAccept :: Assertion

46caseParseHttpAccept = do

47caseParseHttpAccept = do

47 let input =

48 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"

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

50 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

52caseParseRequestBody :: Assertion

53caseParseRequestBody :: Assertion

53caseParseRequestBody = t where

54caseParseRequestBody = t where

54− content2 = B8.pack $

55+ content2 = S8.pack $

55 "--AaB03x\n" ++

56 "--AaB03x\n" ++

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

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

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

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

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

67 "This is my file\n" ++

68 "This is my file\n" ++

68 "file test\n" ++

69 "file test\n" ++

69 "--AaB03x--"

70 "--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"

71 t = do

72 t = do

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

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

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

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

74 result1 <- parseRequestBody lbsSink $ toRequest ctype1 content1

75 result1 <- parseRequestBody lbsSink $ toRequest ctype1 content1

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

76 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")], [])

77 result1

78 result1

78 putStrLn "passed 1" -- FIXME remove

79 putStrLn "passed 1" -- FIXME remove

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

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

81 result2 <- parseRequestBody lbsSink $ toRequest ctype2 content2

82 result2 <- parseRequestBody lbsSink $ toRequest ctype2 content2

82 let expectedsmap2 =

83 let expectedsmap2 =

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

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

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

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

85 ]

86 ]

86 let expectedfile2 =

87 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

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

89 "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)

90 assertEqual "parsing post multipart/form-data"

91 assertEqual "parsing post multipart/form-data"

91 expected2

92 expected2

92 result2

93 result2

93 putStrLn "passed 2" -- FIXME remove

94 putStrLn "passed 2" -- FIXME remove

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

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

96 result3 <- parseRequestBody lbsSink $ toRequest ctype3 content3

97 result3 <- parseRequestBody lbsSink $ toRequest ctype3 content3

97 let expectedsmap3 = []

98 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") $

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

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

100 let expected3 = (expectedsmap3, expectedfile3)

101 let expected3 = (expectedsmap3, expectedfile3)

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

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

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

116 result3'

117 result3'

117 putStrLn "passed 5" -- FIXME remove

118 putStrLn "passed 5" -- FIXME remove

118

119

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

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

120toRequest ctype content = Request

121toRequest ctype content = Request

121 { requestHeaders = [(ReqContentType, ctype)]

122 { requestHeaders = [(ReqContentType, ctype)]

122 , requestBody = toSource content

123 , requestBody = toSource content

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

131 , remoteHost = undefined

132 , remoteHost = undefined

132 }

133 }

133

134

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

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

135toRequest' ctype content = Request

136toRequest' ctype content = Request

136 { requestHeaders = [(ReqContentType, ctype)]

137 { requestHeaders = [(ReqContentType, ctype)]

137 , requestBody = toSource' content

138 , requestBody = toSource' content

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

146 , remoteHost = undefined

147 , remoteHost = undefined

147 }

148 }

148

149

149−toSource :: B8.ByteString -> Source

150+toSource :: S8.ByteString -> Source

150toSource bs = Source $

151toSource bs = Source $

151− case B8.uncons bs of

152+ case S8.uncons bs of

152 Nothing -> return Nothing

153 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)

154

155

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

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

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

157toSource' 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 "")