187e086 · typeable/wai

git.iko.soy/typeable/wai

conduit 1.0 compatibility

commit187e086bd5d5bcf6f1847ff5cbe9a1f1c3d91d50 authorMichael Snoyman <michael@snoyman.com> dateSun 10 Feb 2013, 17:36 (14 years ago) parentaacb9f8

16 files changed+98−30

compare with master

unifiedsplit

wai-eventsource/wai-eventsource.cabal+1−1 wai-extra/Network/Wai/Handler/CGI.hs+1−1 wai-extra/Network/Wai/Parse.hs+59−2 wai-extra/wai-extra.cabal+3−3 wai-frontend-monadcgi/wai-frontend-monadcgi.cabal+1−1 wai-handler-launch/Network/Wai/Handler/Launch.hs+3−3 wai-handler-launch/wai-handler-launch.cabal+3−3 wai-test/Network/Wai/Test.hs+1−1 wai-test/wai-test.cabal+2−2 wai-websockets/wai-websockets.cabal+1−1 wai/wai.cabal+1−1 warp-tls/Network/Wai/Handler/WarpTLS.hs+1−1 warp-tls/warp-tls.cabal+2−2 warp/Network/Wai/Handler/Warp/Request.hs+1−1 warp/Network/Wai/Handler/Warp/Response.hs+13−2 warp/warp.cabal+5−5

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

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

1717 base >= 4.3 && < 5

1818 , bytestring >= 0.9.1.4

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

20− , conduit >= 0.5 && < 0.6

20+ , conduit >= 0.5 && < 1.1

2121 , http-types >= 0.7

2222 , wai >= 1.3 && < 1.4

2323 , 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

141141 , fromByteString sf

142142 , fromByteString " not supported"

143143 ]

144− bsSink = awaitE >>= either return push

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

145145 push (Chunk bs) = do

146146 liftIO $ outputH bs

147147 bsSink

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

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

22{-# LANGUAGE OverloadedStrings #-}

33{-# LANGUAGE ExistentialQuantification #-}

44{-# LANGUAGE PatternGuards #-}

5+{-# LANGUAGE TypeFamilies #-}

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

78module Network.Wai.Parse

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

5051import Control.Monad (when, unless)

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

5253import 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

5358

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

5560breakDiscard w s =

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

184189conduitRequestBody backend (Multipart bound) =

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

186191

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

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

194+#else

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

196+#endif

188197takeLine =

189198 go id

190199 where

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

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

200209 return $ Just $ killCR x

201210

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

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

213+#else

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

215+#endif

203216takeLines = do

204217 res <- takeLine

205218 case res of

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

212225

213226parsePieces :: BackEnd y

214227 -> S.ByteString

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

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

230+#else

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

232+#endif

216233parsePieces sink bound =

217234 loop

218235 where

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

287304 -> S.ByteString

288305 -> FileInfo ()

289306 -> BackEnd y

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

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

309+#else

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

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

311+#endif

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

292330

293331conduitTillBound :: Monad m

294332 => S.ByteString -- bound

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

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

335+#else

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

337+#endif

296338conduitTillBound bound =

297339 go id

298340 where

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

323365sinkTillBound :: S.ByteString

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

325367 -> x

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

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

370+#else

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

372+#endif

327373sinkTillBound bound iter seed0 =

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

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

375+ streamFromPipe $

376+#endif

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

329378 where

330379 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

331388

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

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

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

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

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

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

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

39− , conduit >= 0.5 && < 0.6

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

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

39+ , conduit >= 0.5 && < 1.1

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

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

4242 , ansi-terminal

4343 , resourcet >= 0.3 && < 0.5

4444 , void >= 0.5 && < 0.6

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

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

1616 , bytestring

1717 , containers >= 0.2

1818 , cgi

19− , conduit >= 0.5 && < 0.6

19+ , conduit >= 0.5 && < 1.1

2020 , http-types

2121 , transformers

2222 , case-insensitive

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

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

6060toInsert :: S.ByteString

6161toInsert = "<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>"

6262

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)

6464insideHead =

6565 loop' (S.empty, whole)

6666 where

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

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

6868 whole = "<head>"

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

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

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

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

8989 loop' (held', atFront')

9090

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

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

9292

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

9494getOverlap whole x =

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

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

1919 , transformers >= 0.2.2 && < 0.4

2020 , bytestring >= 0.9.1.4

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

22− , conduit >= 0.5 && < 0.6

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

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

22+ , conduit >= 0.5 && < 1.1

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

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

2525

2626 if os(windows)

2727 c-sources: windows.c

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

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

9999

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

101101runResponse 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

103103 return $ SResponse s h $ L.fromChunks bss

104104 where

105105 (s, h, body) = responseSource res

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

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

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

2121 , transformers >= 0.2.2 && < 0.4

2222 , containers >= 0.2

23− , conduit >= 0.5 && < 0.6

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

23+ , conduit >= 0.5 && < 1.1

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

2525 , cookie >= 0.2 && < 0.5

2626 , HUnit >= 1.2 && < 1.3

2727 , http-types >= 0.7

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

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

1919Library

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

2121 , bytestring >= 0.9.1.4

22− , conduit >= 0.5 && < 0.6

22+ , conduit >= 0.5 && < 1.1

2323 , wai >= 1.3 && < 1.4

2424 , enumerator >= 0.4.8 && < 0.5

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

wai/wai.cabal+1−1

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

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

2121 , bytestring >= 0.9.1.4

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

23− , conduit >= 0.5 && < 0.6

23+ , conduit >= 0.5 && < 1.1

2424 , network >= 2.2.1.5

2525 , http-types >= 0.7

2626 , text >= 0.7

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

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

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

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

130130

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

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

132132takeMost i =

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

134134 where

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

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

1818 , wai >= 1.3 && < 1.4

1919 , warp >= 1.3.5 && < 1.4

2020 , transformers >= 0.2

21− , conduit >= 0.5 && < 0.6

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

21+ , conduit >= 0.5 && < 1.1

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

2323 , certificate >= 1.2

2424 , pem >= 0.1

2525 , cryptocipher >= 0.3

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

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

147147close :: Sink ByteString (ResourceT IO) a

148148close = throwIO IncompleteHeaders

149149

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

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

151151push (THStatus len lines prepend) bs

152152 -- Too many bytes

153153 | len > maxTotalHeaderLength = throwIO OverLargeHeader

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

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

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

1616import qualified Data.CaseInsensitive as CI

1717import Data.Conduit

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

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

20+#endif

1821import Data.Conduit.Blaze (builderToByteString)

1922import qualified Data.Conduit.List as CL

2023import Data.Maybe (isJust)

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

107110 return isPersist

108111 where

109112 th = threadHandle cleaner

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

113+ body =

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

115+ SourceM $

116+#endif

117+ mapOutput (\x -> case x of

111118 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

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

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

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

warp/warp.cabal+5−5

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

2323Library

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

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

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

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

2727 , bytestring >= 0.9.1.4

2828 , case-insensitive >= 0.2

29− , conduit >= 0.5 && < 0.6

29+ , conduit >= 0.5 && < 1.1

3030 , ghc-prim

3131 , http-types >= 0.7

3232 , lifted-base >= 0.1

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

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

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

3535 , transformers >= 0.2.2 && < 0.4

3636 , unix-compat >= 0.2

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

7171 Ghc-Options: -Wall

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

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

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

74+ , blaze-builder-conduit >= 0.5

7575 , bytestring >= 0.9.1.4

7676 , case-insensitive >= 0.2

77− , conduit >= 0.5 && < 0.6

77+ , conduit >= 0.5

7878 , ghc-prim

7979 , http-types >= 0.7

8080 , lifted-base >= 0.1