63fac2b · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Removed enumerator from wai-extra

63fac2bMichael Snoyman15 years ago

wai-extra/Network/Wai/Middleware/RequestLogger.hs+1−2

compare with master

unifiedsplit

@@ -20,7 +20,6 @@ import qualified Data.Text.Encoding as TE

21import Network.Wai.Parse (parseRequestBody, lbsSink, fileName, Param, File)

22import qualified Data.ByteString.Lazy as LBS

23−import Data.Enumerator (run_, ($$), enumList)

24import System.IO (hPutStrLn, stderr)

23import System.IO (hPutStrLn, stderr)

26import qualified Data.Conduit as C

25import qualified Data.Conduit as C

@@ -95,7 +94,7 @@ logHandleDev cb app req = do

95 if null params then ""

94 if null params then ""

96 else BS.concat ["\n", prefix, pack (show params)]

95 else BS.concat ["\n", prefix, pack (show params)]

98− allPostParams req' body = run_ $ enumList 1 body $$ parseRequestBody lbsSink req'

97+ allPostParams req' body = C.runResourceT $ CL.sourceList body C.$$ parseRequestBody lbsSink req'

100 emptyGetParam :: (BS.ByteString, Maybe BS.ByteString) -> (BS.ByteString, BS.ByteString)

99 emptyGetParam :: (BS.ByteString, Maybe BS.ByteString) -> (BS.ByteString, BS.ByteString)

101 emptyGetParam (k, Just v) = (k,v)

100 emptyGetParam (k, Just v) = (k,v)

wai-extra/Network/Wai/Parse.hs+38−67

@@ -32,9 +32,8 @@ import Data.Function (on)

32import System.Directory (removeFile, getTemporaryDirectory)

33import System.IO (hClose, openBinaryTempFile, Handle)

34import Network.Wai

35−import Data.Enumerator (Iteratee, yield)

36−import qualified Data.Enumerator as E

35+import qualified Data.Conduit as C

37−import qualified Data.Enumerator.List as EL

36+import qualified Data.Conduit.List as CL

38import Control.Monad.IO.Class (liftIO)

37import Control.Monad.IO.Class (liftIO)

39import qualified Network.HTTP.Types as H

38import qualified Network.HTTP.Types as H

@@ -129,7 +128,7 @@ type File y = (S.ByteString, FileInfo y)

129

128

130parseRequestBody :: Sink x y

129parseRequestBody :: Sink x y

131 -> Request

130 -> Request

132− -> Iteratee S.ByteString IO ([Param], [File y])

131+ -> C.Sink S.ByteString IO ([Param], [File y])

133parseRequestBody sink req = do

132parseRequestBody sink req = do

134 case ctype of

133 case ctype of

135 Nothing -> return ([], [])

134 Nothing -> return ([], [])

@@ -137,7 +136,7 @@ parseRequestBody sink req = do

137 -- NOTE: in general, url-encoded data will be in a single chunk.

136 -- NOTE: in general, url-encoded data will be in a single chunk.

138 -- Therefore, I'm optimizing for the usual case by sticking with

137 -- Therefore, I'm optimizing for the usual case by sticking with

139 -- strict byte strings here.

138 -- strict byte strings here.

140− bs <- EL.consume

139+ bs <- CL.consume

141 return (H.parseSimpleQuery $ S.concat bs, [])

140 return (H.parseSimpleQuery $ S.concat bs, [])

142 Just (Just bound) -> -- multi-part

141 Just (Just bound) -> -- multi-part

143 let bound'' = S8.pack "--" `S.append` bound

142 let bound'' = S8.pack "--" `S.append` bound

@@ -162,24 +161,20 @@ parseRequestBody sink req = do

162 Just x -> Just $ Just x

161 Just x -> Just $ Just x

163 Nothing -> Nothing

162 Nothing -> Nothing

164

163

165−takeLine :: Iteratee S.ByteString IO (Maybe S.ByteString)

164+takeLine :: C.Sink S.ByteString IO (Maybe S.ByteString)

166−takeLine = do

165+takeLine =

167− mbs <- EL.head

166+ C.sinkState id push close

168− case mbs of

167+ where

169− Nothing -> return Nothing

168+ close _ = return Nothing

170− Just bs ->

169+ push front bs = do

171− let (x, y) = S.break (== 10) bs -- LF

170+ let (x, y) = S.break (== 10) $ front bs -- LF

172− in if S.null y

171+ in if S.null y

173− then do

172+ then return (S.append x, C.Processing)

174− x' <- takeLine

175− case x' of

176− Nothing -> return $ Just $ killCR x

177− Just x'' -> return $ Just $ killCR $ S.append x x''

178− else do

173+ else do

179− E.yield () $ E.Chunks [S.drop 1 y]

174+ let lo = if S.length y > 1 then Just (S.drop 1 y) else Nothing

180− return $ Just $ killCR x

175+ return (error "takeLine", C.Done lo $ Just $ killCR x)

181

176

182−takeLines :: Iteratee S.ByteString IO [S.ByteString]

177+takeLines :: C.Sink S.ByteString IO [S.ByteString]

183takeLines = do

178takeLines = do

184 res <- takeLine

179 res <- takeLine

185 case res of

180 case res of

@@ -191,7 +186,7 @@ takeLines = do

191 return $ l : ls

186 return $ l : ls

192

187

193parsePieces :: Sink x y -> S.ByteString

188parsePieces :: Sink x y -> S.ByteString

194− -> Iteratee S.ByteString IO ([Param], [File y])

189+ -> C.Sink S.ByteString IO ([Param], [File y])

195parsePieces sink bound = do

190parsePieces sink bound = do

196 _boundLine <- takeLine

191 _boundLine <- takeLine

197 res' <- takeLines

192 res' <- takeLines

@@ -271,56 +266,32 @@ findBound b bs = go [0..S.length bs - 1]

271sinkTillBound :: S.ByteString

266sinkTillBound :: S.ByteString

272 -> (x -> S.ByteString -> IO x)

267 -> (x -> S.ByteString -> IO x)

273 -> x

268 -> x

274− -> Iteratee S.ByteString IO (x, Bool)

269+ -> C.Sink S.ByteString IO (x, Bool)

275−sinkTillBound bound iter seed = do

270+sinkTillBound bound iter seed0 = C.sinkState

276− mbs <- EL.head

271+ (id, seed0)

277− case mbs of

272+ push

278− Nothing -> return (seed, False)

273+ close

279− Just bs -> go bs

280 where

274 where

281− go bs =

275+ close (front, seed) = do

276+ seed' <- liftIO $ iter seed $ front S.empty

277+ return (seed', False)

278+ push (front, seed) bs' = do

279+ let bs = front bs'

282 case findBound bound bs of

280 case findBound bound bs of

283 FoundBound before after -> do

281 FoundBound before after -> do

284 let before' = killCRLF before

282 let before' = killCRLF before

285 seed' <- liftIO $ iter seed before'

283 seed' <- liftIO $ iter seed before'

286− yield () $ E.Chunks [after]

284+ return (undefined, C.Done (Just after) (seed', True))

287− return (seed', True)

288− PartialBound -> do

289− mbs <- EL.head

290− case mbs of

291− Nothing -> do

292− seed' <- liftIO $ iter seed bs

293− return (seed', False)

294− Just bs2 -> do

295− let bs' = bs `S.append` bs2

296− yield () $ E.Chunks [bs']

297− sinkTillBound bound iter seed

298 NoBound -> do

285 NoBound -> do

299− mbs <- EL.head

286+ -- don't emit newlines, in case it's part of a bound

300− case mbs of

287+ let (toEmit, front') =

301− Nothing -> do

302− seed' <- liftIO $ iter seed bs

303− sinkTillBound bound iter seed'

304− Just bs' -> do

305− -- this funny bit is to catch when there's a

306− -- newline at the end of the previous chunk

307− (seed', bs'') <-

308− if not (S8.null bs) && S8.last bs `elem` "\n\r"

288+ if not (S8.null bs) && S8.last bs `elem` "\r\n"

309− then do

310− let (front, back) =

311− S.splitAt (S.length bs - 2) bs

289+ then let (x, y) = S.splitAt (S.length bs - 2) bs

312− seed' <- liftIO $ iter seed front

313− return (seed', back `S.append` bs')

290+ in (x, S.append y)

314− else do

291+ else (bs, id)

315− seed' <- liftIO $ iter seed bs

292+ seed' <- liftIO $ iter seed toEmit

316− return (seed', bs')

293+ return ((front', seed'), C.Processing)

317− yield () $ E.Chunks [bs'']

294+ PartialBound -> return ((S.append bs, seed), C.Processing)

318− sinkTillBound bound iter seed'

319− {-

320− NoBound -> do

321− case msrc of

322− Just (bs', src') -> do

323− -}

324

295

325parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]

296parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]

326parseAttrs = map go . S.split 59 -- semicolon

297parseAttrs = map go . S.split 59 -- semicolon

wai-extra/test/WaiExtraTest.hs+11−6

@@ -24,11 +24,13 @@ import Network.Wai.Middleware.AcceptOverride

24import Network.Wai.Middleware.Debug (debugHandle)

25import Codec.Compression.GZip (decompress)

27−import Data.Enumerator (run_, enumList, ($$), Iteratee)

27+import qualified Data.Conduit as C

28+import qualified Data.Conduit.List as CL

28−import Data.Enumerator.Binary (enumFile)

29+import Data.Conduit.Binary (sourceFile)

29import Control.Monad.IO.Class (liftIO)

30import Control.Monad.IO.Class (liftIO)

30import Data.Maybe (fromMaybe)

31import Data.Maybe (fromMaybe)

31import Network.HTTP.Types (parseSimpleQuery, status200)

32import Network.HTTP.Types (parseSimpleQuery, status200)

33+import Data.Monoid (mappend)

33specs :: Specs

35specs :: Specs

34specs = do

36specs = do

@@ -95,12 +97,14 @@ caseParseHttpAccept = do

96parseRequestBody' :: Sink ([S8.ByteString] -> [S8.ByteString]) L.ByteString

98parseRequestBody' :: Sink ([S8.ByteString] -> [S8.ByteString]) L.ByteString

97 -> SRequest

99 -> SRequest

98− -> Iteratee S.ByteString IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo L.ByteString)])

100+ -> C.ResourceT IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo L.ByteString)])

99parseRequestBody' sink (SRequest req bod) =

101parseRequestBody' sink (SRequest req bod) =

100− enumList 1 (L.toChunks bod) $$ parseRequestBody sink req

102+ CL.sourceList (L.toChunks bod) C.$$ parseRequestBody sink req

101

103

102caseParseRequestBody :: Assertion

104caseParseRequestBody :: Assertion

103−caseParseRequestBody = run_ t where

105+caseParseRequestBody =

106+ C.runResourceT t

107+ where

104 content2 = S8.pack $

108 content2 = S8.pack $

105 "--AaB03x\n" ++

109 "--AaB03x\n" ++

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

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

@@ -394,7 +398,8 @@ caseDalvikMultipart = do

394 let request' = defaultRequest

398 let request' = defaultRequest

395 { requestHeaders = headers

399 { requestHeaders = headers

396 }

400 }

401+ (params, files) <- C.runResourceT $ sourceFile "test/requests/dalvik-request"

397− (params, files) <- run_ $ enumFile "test/requests/dalvik-request" $$ parseRequestBody lbsSink request'

402+ C.$$ parseRequestBody lbsSink request'

398 lookup "scannedTime" params @?= Just "1.298590056748E9"

403 lookup "scannedTime" params @?= Just "1.298590056748E9"

399 lookup "geoLong" params @?= Just "0"

404 lookup "geoLong" params @?= Just "0"

400 lookup "geoLat" params @?= Just "0"

405 lookup "geoLat" params @?= Just "0"

wai-extra/wai-extra.cabal−4

@@ -38,8 +38,6 @@ Library

38 , conduit

39 , zlib-conduit

40 , blaze-builder-conduit

41− -- FIXME this must be removed

42− , enumerator

44 Exposed-modules: Network.Wai.Handler.CGI

42 Exposed-modules: Network.Wai.Handler.CGI

45 Network.Wai.Middleware.AcceptOverride

43 Network.Wai.Middleware.AcceptOverride

@@ -78,8 +76,6 @@ test-suite tests

78 , blaze-builder >= 0.2.1.4 && < 0.4

76 , blaze-builder >= 0.2.1.4 && < 0.4

79 , data-default

77 , data-default

80 , conduit

78 , conduit

81− -- FIXME this must be removed

82− , enumerator

84source-repository head

80source-repository head

85 type: git

81 type: git