187e086 · typeable/wai

wai-eventsource/wai-eventsource.cabal+1−1

compare with master

unifiedsplit

@@ -17,7 +17,7 @@ Library

17 base >= 4.3 && < 5

18 , bytestring >= 0.9.1.4

19 , blaze-builder >= 0.3 && < 0.4

20− , conduit >= 0.5 && < 0.6

20+ , conduit >= 0.5 && < 1.1

21 , http-types >= 0.7

22 , wai >= 1.3 && < 1.4

23 , warp >= 1.3 && < 1.4

wai-extra/Network/Wai/Handler/CGI.hs+1−1

@@ -141,7 +141,7 @@ runGeneric vars inputH outputH xsendfile app = do

141 , fromByteString sf

142 , fromByteString " not supported"

143 ]

144− bsSink = awaitE >>= either return push

144+ bsSink = await >>= maybe (return ()) push

145 push (Chunk bs) = do

146 liftIO $ outputH bs

147 bsSink

wai-extra/Network/Wai/Parse.hs+59−2

@@ -2,6 +2,7 @@

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE ExistentialQuantification #-}

4{-# LANGUAGE PatternGuards #-}

5+{-# LANGUAGE TypeFamilies #-}

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

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

6

7

7module Network.Wai.Parse

8module Network.Wai.Parse

@@ -50,6 +51,10 @@ import Data.Either (partitionEithers)

50import Control.Monad (when, unless)

51import Control.Monad (when, unless)

51import Control.Monad.Trans.Class (lift)

52import Control.Monad.Trans.Class (lift)

52import Control.Monad.Trans.Resource (allocate, release, register)

53import Control.Monad.Trans.Resource (allocate, release, register)

54+#if MIN_VERSION_conduit(1, 0, 0)

55+import Data.Conduit.Internal (Pipe (NeedInput, HaveOutput), (>+>), withUpstream, Sink (..), injectLeftovers, streamFromPipe, ConduitM)

56+import Data.Void (Void)

57+#endif

53

58

54breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)

59breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)

55breakDiscard w s =

60breakDiscard w s =

@@ -184,7 +189,11 @@ conduitRequestBody _ UrlEncoded = do

184conduitRequestBody backend (Multipart bound) =

189conduitRequestBody backend (Multipart bound) =

185 parsePieces backend $ S8.pack "--" `S.append` bound

190 parsePieces backend $ S8.pack "--" `S.append` bound

186

191

192+#if MIN_VERSION_conduit(1, 0, 0)

193+takeLine :: MonadSink S.ByteString m (Maybe S.ByteString)

194+#else

187takeLine :: Monad m => Pipe S.ByteString S.ByteString o u m (Maybe S.ByteString)

195takeLine :: Monad m => Pipe S.ByteString S.ByteString o u m (Maybe S.ByteString)

196+#endif

188takeLine =

197takeLine =

189 go id

198 go id

190 where

199 where

@@ -199,7 +208,11 @@ takeLine =

199 when (S.length y > 1) $ leftover $ S.drop 1 y

208 when (S.length y > 1) $ leftover $ S.drop 1 y

200 return $ Just $ killCR x

209 return $ Just $ killCR x

201

210

211+#if MIN_VERSION_conduit(1, 0, 0)

212+takeLines :: MonadSink S.ByteString (ResourceT IO) [S.ByteString]

213+#else

202takeLines :: Pipe S.ByteString S.ByteString o u (ResourceT IO) [S.ByteString]

214takeLines :: Pipe S.ByteString S.ByteString o u (ResourceT IO) [S.ByteString]

215+#endif

203takeLines = do

216takeLines = do

204 res <- takeLine

217 res <- takeLine

205 case res of

218 case res of

@@ -212,7 +225,11 @@ takeLines = do

212

225

213parsePieces :: BackEnd y

226parsePieces :: BackEnd y

214 -> S.ByteString

227 -> S.ByteString

228+#if MIN_VERSION_conduit(1, 0, 0)

229+ -> ConduitM S.ByteString (Either Param (File y)) (ResourceT IO) ()

230+#else

215 -> Pipe S.ByteString S.ByteString (Either Param (File y)) u (ResourceT IO) ()

231 -> Pipe S.ByteString S.ByteString (Either Param (File y)) u (ResourceT IO) ()

232+#endif

216parsePieces sink bound =

233parsePieces sink bound =

217 loop

234 loop

218 where

235 where

@@ -287,12 +304,37 @@ sinkTillBound' :: S.ByteString

287 -> S.ByteString

304 -> S.ByteString

288 -> FileInfo ()

305 -> FileInfo ()

289 -> BackEnd y

306 -> BackEnd y

307+#if MIN_VERSION_conduit(1, 0, 0)

308+ -> ConduitM S.ByteString o (ResourceT IO) (Bool, y)

309+#else

290 -> Pipe S.ByteString S.ByteString o u (ResourceT IO) (Bool, y)

310 -> Pipe S.ByteString S.ByteString o u (ResourceT IO) (Bool, y)

311+#endif

291−sinkTillBound' bound name fi sink = conduitTillBound bound >+> withUpstream (sinkToPipe $ sink name fi)

312+sinkTillBound' bound name fi sink =

313+#if MIN_VERSION_conduit(1, 0, 0)

314+ streamFromPipe $ anyOutput $

315+#endif

316+ conduitTillBound bound >+> withUpstream (fix $ sink name fi)

317+ where

318+#if MIN_VERSION_conduit(1, 0, 0)

319+ fix :: Sink S8.ByteString (ResourceT IO) y -> Pipe Void S8.ByteString Void Bool (ResourceT IO) y

320+ fix (Sink p) = ignoreTerm >+> injectLeftovers p

321+ ignoreTerm = await' >>= maybe (return ()) (\x -> yield' x >> ignoreTerm)

322+ await' = NeedInput (return . Just) (const $ return Nothing)

323+ yield' = HaveOutput (return ()) (return ())

324+

325+ anyOutput p = p >+> dropInput

326+ dropInput = NeedInput (const dropInput) return

327+#else

328+ fix = sinkToPipe

329+#endif

292

330

293conduitTillBound :: Monad m

331conduitTillBound :: Monad m

294 => S.ByteString -- bound

332 => S.ByteString -- bound

333+#if MIN_VERSION_conduit(1, 0, 0)

334+ -> Pipe S.ByteString S.ByteString S.ByteString () m Bool

335+#else

295 -> Pipe S.ByteString S.ByteString S.ByteString u m Bool

336 -> Pipe S.ByteString S.ByteString S.ByteString u m Bool

337+#endif

296conduitTillBound bound =

338conduitTillBound bound =

297 go id

339 go id

298 where

340 where

@@ -323,11 +365,26 @@ conduitTillBound bound =

323sinkTillBound :: S.ByteString

365sinkTillBound :: S.ByteString

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

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

325 -> x

367 -> x

368+#if MIN_VERSION_conduit(1, 0, 0)

369+ -> MonadSink S.ByteString (ResourceT IO) (Bool, x)

370+#else

326 -> Pipe S.ByteString S.ByteString o u (ResourceT IO) (Bool, x)

371 -> Pipe S.ByteString S.ByteString o u (ResourceT IO) (Bool, x)

372+#endif

327sinkTillBound bound iter seed0 =

373sinkTillBound bound iter seed0 =

374+#if MIN_VERSION_conduit(1, 0, 0)

375+ streamFromPipe $

376+#endif

328− conduitTillBound bound >+> withUpstream (CL.foldM iter' seed0)

377+ (conduitTillBound bound >+> (withUpstream $ ij $ CL.foldM iter' seed0))

329 where

378 where

330 iter' a b = liftIO $ iter a b

379 iter' a b = liftIO $ iter a b

380+#if MIN_VERSION_conduit(1, 0, 0)

381+ ij p = ignoreTerm >+> injectLeftovers p

382+ ignoreTerm = await' >>= maybe (return ()) (\x -> yield' x >> ignoreTerm)

383+ await' = NeedInput (return . Just) (const $ return Nothing)

384+ yield' = HaveOutput (return ()) (return ())

385+#else

386+ ij = id

387+#endif

331

388

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

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

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

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

wai-extra/wai-extra.cabal+3−3

@@ -36,9 +36,9 @@ Library

36 , date-cache >= 0.3 && < 0.4

37 , fast-logger >= 0.2 && < 0.4

38 , wai-logger >= 0.2 && < 0.4

39− , conduit >= 0.5 && < 0.6

39+ , conduit >= 0.5 && < 1.1

40− , zlib-conduit >= 0.5 && < 0.6

40+ , zlib-conduit >= 0.5 && < 1.1

41− , blaze-builder-conduit >= 0.5 && < 0.6

41+ , blaze-builder-conduit >= 0.5 && < 1.1

42 , ansi-terminal

43 , resourcet >= 0.3 && < 0.5

44 , void >= 0.5 && < 0.6

wai-frontend-monadcgi/wai-frontend-monadcgi.cabal+1−1

@@ -16,7 +16,7 @@ library

16 , bytestring

17 , containers >= 0.2

18 , cgi

19− , conduit >= 0.5 && < 0.6

19+ , conduit >= 0.5 && < 1.1

20 , http-types

21 , transformers

22 , case-insensitive

wai-handler-launch/Network/Wai/Handler/Launch.hs+3−3

@@ -60,11 +60,11 @@ ping var app req

60toInsert :: S.ByteString

61toInsert = "<script>setInterval(function(){var x;if(window.XMLHttpRequest){x=new XMLHttpRequest();}else{x=new ActiveXObject(\"Microsoft.XMLHTTP\");}x.open(\"GET\",\"/_ping\",false);x.send();},60000)</script>"

62

63−insideHead :: Pipe l (Flush S.ByteString) (Flush S.ByteString) r (ResourceT IO) r

63+insideHead :: Conduit (Flush S.ByteString) (ResourceT IO) (Flush S.ByteString)

64insideHead =

65 loop' (S.empty, whole)

66 where

67− loop' state = awaitE >>= either (close state) (push' state)

67+ loop' state = await >>= maybe (close state) (push' state)

68 whole = "<head>"

69 push' state (Chunk x) = push state x

70 push' state Flush = yield Flush >> loop' state

@@ -88,7 +88,7 @@ insideHead =

88 mapM_ (yield . Chunk) [held, x']

89 loop' (held', atFront')

90

91− close (held, _) r = mapM_ yield [Chunk held, Chunk toInsert] >> return r

91+ close (held, _) = mapM_ yield [Chunk held, Chunk toInsert]

92

93getOverlap :: S.ByteString -> S.ByteString -> (S.ByteString, S.ByteString, S.ByteString)

94getOverlap whole x =

wai-handler-launch/wai-handler-launch.cabal+3−3

@@ -19,9 +19,9 @@ Library

19 , transformers >= 0.2.2 && < 0.4

20 , bytestring >= 0.9.1.4

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

22− , conduit >= 0.5 && < 0.6

22+ , conduit >= 0.5 && < 1.1

23− , blaze-builder-conduit >= 0.5 && < 0.6

23+ , blaze-builder-conduit >= 0.5 && < 1.1

24− , zlib-conduit >= 0.5 && < 0.6

24+ , zlib-conduit >= 0.5 && < 1.1

25

26 if os(windows)

27 c-sources: windows.c

wai-test/Network/Wai/Test.hs+1−1

@@ -99,7 +99,7 @@ srequest (SRequest req bod) = do

99

100runResponse :: Response -> C.ResourceT IO SResponse

101runResponse res = do

102− bss <- C.mapOutput toBuilder body C.$= builderToByteString C.$$ CL.consume

102+ bss <- body C.$= CL.map toBuilder C.$= builderToByteString C.$$ CL.consume

103 return $ SResponse s h $ L.fromChunks bss

104 where

105 (s, h, body) = responseSource res

wai-test/wai-test.cabal+2−2

@@ -20,8 +20,8 @@ library

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

21 , transformers >= 0.2.2 && < 0.4

22 , containers >= 0.2

23− , conduit >= 0.5 && < 0.6

23+ , conduit >= 0.5 && < 1.1

24− , blaze-builder-conduit >= 0.5 && < 0.6

24+ , blaze-builder-conduit >= 0.5 && < 1.1

25 , cookie >= 0.2 && < 0.5

26 , HUnit >= 1.2 && < 1.3

27 , http-types >= 0.7

wai-websockets/wai-websockets.cabal+1−1

@@ -19,7 +19,7 @@ flag example

19Library

20 Build-Depends: base >= 3 && < 5

21 , bytestring >= 0.9.1.4

22− , conduit >= 0.5 && < 0.6

22+ , conduit >= 0.5 && < 1.1

23 , wai >= 1.3 && < 1.4

24 , enumerator >= 0.4.8 && < 0.5

25 , network-enumerator >= 0.1.2 && < 0.2

wai/wai.cabal+1−1

@@ -20,7 +20,7 @@ Library

20 Build-Depends: base >= 4 && < 5

21 , bytestring >= 0.9.1.4

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

23− , conduit >= 0.5 && < 0.6

23+ , conduit >= 0.5 && < 1.1

24 , network >= 2.2.1.5

25 , http-types >= 0.7

26 , text >= 0.7

warp-tls/Network/Wai/Handler/WarpTLS.hs+1−1

@@ -128,7 +128,7 @@ readPrivateKey filepath = do

128 $ filter ((== "RSA PRIVATE KEY") . PEM.pemName) pems

129 parseKey (Left err) = error $ "Cannot parse PEM file: " ++ err

130

131−takeMost :: Monad m => Int -> C.GLSink B.ByteString m B.ByteString

131+takeMost :: Monad m => Int -> C.Sink B.ByteString m B.ByteString

132takeMost i =

133 C.await >>= maybe (return B.empty) go

134 where

warp-tls/warp-tls.cabal+2−2

@@ -18,8 +18,8 @@ Library

18 , wai >= 1.3 && < 1.4

19 , warp >= 1.3.5 && < 1.4

20 , transformers >= 0.2

21− , conduit >= 0.5 && < 0.6

21+ , conduit >= 0.5 && < 1.1

22− , network-conduit >= 0.6 && < 0.7

22+ , network-conduit >= 0.6 && < 1.1

23 , certificate >= 1.2

24 , pem >= 0.1

25 , cryptocipher >= 0.3

warp/Network/Wai/Handler/Warp/Request.hs+1−1

@@ -147,7 +147,7 @@ takeHeaders =

147close :: Sink ByteString (ResourceT IO) a

148close = throwIO IncompleteHeaders

149

150−push :: THStatus -> ByteString -> Pipe ByteString ByteString Void () (ResourceT IO) [ByteString]

150+push :: THStatus -> ByteString -> Sink ByteString (ResourceT IO) [ByteString]

151push (THStatus len lines prepend) bs

152 -- Too many bytes

153 | len > maxTotalHeaderLength = throwIO OverLargeHeader

warp/Network/Wai/Handler/Warp/Response.hs+13−2

@@ -15,6 +15,9 @@ import Data.ByteString (ByteString)

15import qualified Data.ByteString.Char8 as B (pack)

16import qualified Data.CaseInsensitive as CI

17import Data.Conduit

18+#if MIN_VERSION_conduit(1, 0, 0)

19+import Data.Conduit.Internal (mapOutput, SourceM (..))

20+#endif

18import Data.Conduit.Blaze (builderToByteString)

21import Data.Conduit.Blaze (builderToByteString)

19import qualified Data.Conduit.List as CL

22import qualified Data.Conduit.List as CL

20import Data.Maybe (isJust)

23import Data.Maybe (isJust)

@@ -107,9 +110,17 @@ sendResponse cleaner req conn (ResponseSource s hs bodyFlush)

107 return isPersist

110 return isPersist

108 where

111 where

109 th = threadHandle cleaner

112 th = threadHandle cleaner

113+ body =

114+#if MIN_VERSION_conduit(1, 0, 0)

115+ SourceM $

116+#endif

110− body = mapOutput (\x -> case x of

117+ mapOutput (\x -> case x of

111 Flush -> flush

118 Flush -> flush

112− Chunk builder -> builder) bodyFlush

119+ Chunk builder -> builder)

120+#if MIN_VERSION_conduit(1, 0, 0)

121+ $ unSourceM

122+#endif

123+ bodyFlush

113 cbody = if needsChunked then body $= chunk else body

124 cbody = if needsChunked then body $= chunk else body

114 -- FIXME perhaps alloca a buffer per thread and reuse that in all

125 -- FIXME perhaps alloca a buffer per thread and reuse that in all

115 -- functions below. Should lessen greatly the GC burden (I hope)

126 -- functions below. Should lessen greatly the GC burden (I hope)

warp/warp.cabal+5−5

@@ -23,14 +23,14 @@ Flag network-bytestring

23Library

24 Build-Depends: base >= 3 && < 5

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

26− , blaze-builder-conduit >= 0.5 && < 0.6

26+ , blaze-builder-conduit >= 0.5 && < 1.1

27 , bytestring >= 0.9.1.4

28 , case-insensitive >= 0.2

29− , conduit >= 0.5 && < 0.6

29+ , conduit >= 0.5 && < 1.1

30 , ghc-prim

31 , http-types >= 0.7

32 , lifted-base >= 0.1

33− , network-conduit >= 0.5 && < 0.7

33+ , network-conduit >= 0.5 && < 1.1

34 , simple-sendfile >= 0.2.7 && < 0.3

35 , transformers >= 0.2.2 && < 0.4

36 , unix-compat >= 0.2

@@ -71,10 +71,10 @@ Test-Suite spec

71 Ghc-Options: -Wall

72 Build-Depends: base >= 4 && < 5

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

74− , blaze-builder-conduit >= 0.5 && < 0.6

74+ , blaze-builder-conduit >= 0.5

75 , bytestring >= 0.9.1.4

76 , case-insensitive >= 0.2

77− , conduit >= 0.5 && < 0.6

77+ , conduit >= 0.5

78 , ghc-prim

79 , http-types >= 0.7

80 , lifted-base >= 0.1