@@ -63,7 +63,7 @@ parseQueryString q =
6363
6464
6565qsDecode :: S.ByteString -> S.ByteString
66−qsDecode x = fst $ S.unfoldrN (S.length x) go x
66+qsDecode z = fst $ S.unfoldrN (S.length z) go z
6767 where
6868 go bs =
6969 case uncons bs of
@@ -105,7 +105,8 @@ parseHttpAccept = map fst
105105 . map grabQ
106106 . S.split 44 -- comma
107107 where
108− rcompare x y = compare y x
108+ rcompare :: Double -> Double -> Ordering
109+ rcompare = flip compare
109110 grabQ s =
110111 let (s', q) = breakDiscard 59 s -- semicolon
111112 (_, q') = breakDiscard 61 q -- equals sign
@@ -175,7 +176,7 @@ parseRequestBody sink req = do
175176 return (parseQueryString bs, [])
176177 Just (Just bound) -> -- multi-part
177178 let bound' = S8.pack "--" `S.append` bound
178− in parsePieces sink bound' (S.empty, Just $ requestBody req) True
179+ in parsePieces sink bound' (S.empty, Just $ requestBody req)
179180 where
180181 urlenc = S8.pack "application/x-www-form-urlencoded"
181182 formBound = S8.pack "multipart/form-data; boundary="
@@ -233,15 +234,15 @@ takeLines src = do
233234 Nothing -> return $ Just ([l], src')
234235 Just (ls, src'') -> return $ Just (l : ls, src'')
235236
236−parsePieces :: Sink x y -> S.ByteString -> Source' -> Bool
237+parsePieces :: Sink x y -> S.ByteString -> Source'
237238 -> IO ([Param], [File y])
238−parsePieces sink bound src isFirst = do
239+parsePieces sink bound src = do
239240 res <- takeLine src
240241 src' <- case res of
241242 Nothing -> return (S.empty, Nothing)
242− Just (bs, src') -> return src'
243− res <- takeLines src'
244− case res of
243+ Just (_bs, src') -> return src'
244+ res' <- takeLines src'
245+ case res' of
245246 Nothing -> return ([], [])
246247 Just (ls, src'') -> do
247248 let ls' = map parsePair ls
@@ -263,7 +264,7 @@ parsePieces sink bound src isFirst = do
263264 let y' = (name, fi)
264265 (xs, ys) <-
265266 if wasFound
266− then parsePieces sink bound msrc''' False
267+ then parsePieces sink bound msrc'''
267268 else return ([], [])
268269 return (xs, y' : ys)
269270 Just (_ct, name, Nothing) -> do
@@ -272,17 +273,21 @@ parsePieces sink bound src isFirst = do
272273 (front, wasFound, msrc''') <-
273274 sinkTillBound bound src'' iter seed
274275 let bs = S.concat $ front []
275− let x = (name, qsDecode bs)
276+ let x' = (name, qsDecode bs)
276277 (xs, ys) <-
277278 if wasFound
278− then parsePieces sink bound msrc''' False
279+ then parsePieces sink bound msrc'''
279280 else return ([], [])
280− return (x : xs, ys)
281+ return (x' : xs, ys)
281282 Nothing -> do
282− (isEnd, src''') <- dropTillBound bound src''
283− if isEnd
284− then return ([], [])
285− else parsePieces sink bound src''' False
283+ -- ignore this part
284+ let seed = ()
285+ iter () _ = return ()
286+ ((), wasFound, msrc''') <-
287+ sinkTillBound bound src'' iter seed
288+ if wasFound
289+ then parsePieces sink bound msrc'''
290+ else return ([], [])
286291 where
287292 contDisp = S8.pack "Content-Disposition"
288293 contType = S8.pack "Content-Type"
@@ -364,40 +369,6 @@ sinkTillBound bound (bs, msrc) iter seed = do
364369 let bs'' = bs `S.append` bs'
365370 sinkTillBound bound (bs'', Just src') iter seed
366371
367−dropTillBound :: S.ByteString -> Source' -> IO (Bool, Source')
368−dropTillBound bound (bs, msrc) = do
369− let bound' = S.cons 10 bound
370− let (before, rest) = S.breakSubstring bound' bs
371− x <-
372− if S.null rest
373− then return Nothing
374− else do
375− let after = S.drop (S.length bound') rest
376− if S.take 2 after == S8.pack "--"
377− then return $ Just $ Right (True, (S.empty, Nothing))
378− else
379− if S.take 2 after == S8.pack "\r\n"
380− then return $ Just $ Right
381− (False, (S.drop 2 after, msrc))
382− else
383− if S.take 1 after == S8.pack "\n"
384− then return $ Just $ Right
385− (False, (S.drop 1 after, msrc))
386− else return $ Just $ Left after
387− case x :: Maybe (Either S.ByteString (Bool, Source')) of
388− Just (Right x') -> return x'
389− Just (Left bs') -> dropTillBound bound (bs', msrc)
390− Nothing -> do
391− case msrc of
392− Nothing -> return (True, (S.empty, Nothing))
393− Just (Source src) -> do
394− res <- src
395− case res of
396− Nothing -> return (True, (S.empty, Nothing))
397− Just (bs', src') -> do
398− let msrc' = Just src'
399− dropTillBound bound (bs `S.append` bs', msrc')
400−
401372parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]
402373parseAttrs = map go . S.split 59 -- semicolon
403374 where
@@ -409,10 +380,12 @@ parseAttrs = map go . S.split 59 -- semicolon
409380 let (x, y) = breakDiscard 61 s -- equals sign
410381 in (tw x, dq $ tw y)
411382
383+killCRLF :: S.ByteString -> S.ByteString
412384killCRLF bs
413385 | S.null bs || S8.last bs /= '\n' = bs
414386 | otherwise = killCR $ S.init bs
415387
388+killCR :: S.ByteString -> S.ByteString
416389killCR bs
417390 | S.null bs || S8.last bs /= '\r' = bs
418391 | otherwise = S.init bs