062350e · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Warp compiles with newest WAI/conduit

062350eMichael Snoyman15 years ago

wai/Network/Wai.hs+1−1

compare with master

unifiedsplit

@@ -96,7 +96,7 @@ data Request = Request

96 , pathInfo :: [Text]

97 -- | Parsed query string information

98 , queryString :: H.Query

99− , requestBody :: C.Source IO B.ByteString

99+ , requestBody :: C.BSource IO B.ByteString

100 }

101 deriving (Typeable)

102

warp/Network/Wai/Handler/Warp.hs+32−19

@@ -87,6 +87,7 @@ import Data.Typeable (Typeable)

88import Control.Monad.Trans.Resource (ResourceT, runResourceT)

89import qualified Data.Conduit as C

90+import qualified Data.Conduit.Binary as CB

90import qualified Data.Conduit.List as CL

91import qualified Data.Conduit.List as CL

91import Control.Exception.Lifted (throwIO)

92import Control.Exception.Lifted (throwIO)

92import Blaze.ByteString.Builder.HTTP

93import Blaze.ByteString.Builder.HTTP

@@ -206,9 +207,9 @@ serveConnection settings th onException port app conn remoteHost' = do

206 (sClose conn))

207 (sClose conn))

207 onException

208 onException

208 where

209 where

209− fromClient = sourceSocket th bytesPerRead conn

210 serveConnection' :: ResourceT IO ()

211 serveConnection' = do

212+ fromClient <- C.bufferSource $ sourceSocket th bytesPerRead conn

212 (len, env) <- parseRequest port remoteHost' fromClient

213 (len, env) <- parseRequest port remoteHost' fromClient

213 case settingsIntercept settings env of

214 case settingsIntercept settings env of

214 Nothing -> do

215 Nothing -> do

@@ -223,7 +224,7 @@ serveConnection settings th onException port app conn remoteHost' = do

223 intercept conn-}

224 intercept conn-}

224

225

225parseRequest :: Port -> SockAddr

226parseRequest :: Port -> SockAddr

226− -> C.Source IO S.ByteString

227+ -> C.BSource IO S.ByteString

227 -> ResourceT IO (Integer, Request)

228 -> ResourceT IO (Integer, Request)

228parseRequest port remoteHost' src = do

229parseRequest port remoteHost' src = do

229 headers' <- takeHeaders src

230 headers' <- takeHeaders src

@@ -248,7 +249,7 @@ instance Exception InvalidRequest

248parseRequest' :: Port

249parseRequest' :: Port

249 -> [ByteString]

250 -> [ByteString]

250 -> SockAddr

251 -> SockAddr

251− -> C.Source IO S.ByteString

252+ -> C.BSource IO S.ByteString

252 -> ResourceT IO (Integer, Request)

253 -> ResourceT IO (Integer, Request)

253parseRequest' _ [] _ _ = throwIO $ NotEnoughLines []

254parseRequest' _ [] _ _ = throwIO $ NotEnoughLines []

254parseRequest' port (firstLine:otherLines) remoteHost' src = do

255parseRequest' port (firstLine:otherLines) remoteHost' src = do

@@ -268,6 +269,7 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do

268 let serverName' = takeUntil 58 host -- ':'

269 let serverName' = takeUntil 58 host -- ':'

269 -- FIXME isolate takes an Integer instead of Int or Int64. If this is a

270 -- FIXME isolate takes an Integer instead of Int or Int64. If this is a

270 -- performance penalty, we may need our own version.

271 -- performance penalty, we may need our own version.

272+ rbody <- C.bufferSource $ src C.$= CB.isolate (fromIntegral len)

271 return (len, Request

273 return (len, Request

272 { requestMethod = method

274 { requestMethod = method

273 , httpVersion = httpversion

275 , httpVersion = httpversion

@@ -280,7 +282,7 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do

280 , requestHeaders = heads

282 , requestHeaders = heads

281 , isSecure = False

283 , isSecure = False

282 , remoteHost = remoteHost'

284 , remoteHost = remoteHost'

283− , requestBody = src -- FIXME isolate

285+ , requestBody = rbody

284 })

286 })

285

287

286

288

@@ -424,7 +426,7 @@ sendResponse th req socket r = sendResponse' r

424 `mappend` chunkedTransferTerminator

426 `mappend` chunkedTransferTerminator

425 else (headers' False) `mappend` b

427 else (headers' False) `mappend` b

426

428

427− sendResponse' (ResponseEnumerator res) = error "sendResponse'" {-res enumResponse

429+ sendResponse' (ResponseStream res) = error "sendResponse'" {-res enumResponse

428 where

430 where

429 enumResponse s hs = response True

431 enumResponse s hs = response True

430 where

432 where

@@ -462,27 +464,38 @@ parseHeaderNoAttr s =

462 in (CI.mk k, rest')

464 in (CI.mk k, rest')

463

465

464sourceSocket :: T.Handle -> Int -> Socket -> C.Source IO ByteString

466sourceSocket :: T.Handle -> Int -> Socket -> C.Source IO ByteString

465−sourceSocket th len socket = C.mkSource $ do

467+sourceSocket th len socket = C.Source

468+ { C.sourcePull = do

466− bs <- liftIO $ Sock.recv socket len

469+ bs <- liftIO $ Sock.recv socket len

467− liftIO $ T.tickle th

470+ liftIO $ T.tickle th

468− return $ if S.null bs then C.EOF else C.Chunks [bs]

471+ return $ if S.null bs

472+ then C.SourceResult C.StreamClosed []

473+ else C.SourceResult C.StreamOpen [bs]

474+ , C.sourceClose = return ()

475+ }

469

476

470------ The functions below are not warp-specific and could be split out into a

477------ The functions below are not warp-specific and could be split out into a

471--separate package.

478--separate package.

472

479

473sinkSocket :: T.Handle

480sinkSocket :: T.Handle

474 -> Socket

481 -> Socket

475− -> C.Sink B.ByteString IO ()

482+ -> C.SinkM B.ByteString IO ()

476−sinkSocket th sock =

483+sinkSocket th sock = C.SinkM $ return $ C.SinkData

477− C.Sink $ return $ C.SinkData go

484+ { C.sinkPush = push

485+ , C.sinkClose = close

486+ }

478 where

487 where

488+ close xs = do

489+ liftIO (T.resume th)

490+ liftIO $ Sock.sendMany sock xs

491+ liftIO (T.resume th)

479− go C.EOF = liftIO (T.resume th) >> return (C.SinkResult [] (Just ()))

492+ return (C.SinkResult [] ())

480− go (C.Chunks []) = return $ C.SinkResult [] Nothing

493+ push [] = return $ C.Processing

481− go (C.Chunks xs) = do

494+ push xs = do

482 liftIO $ T.resume th

495 liftIO $ T.resume th

483 liftIO $ Sock.sendMany sock xs

496 liftIO $ Sock.sendMany sock xs

484 liftIO $ T.pause th

497 liftIO $ T.pause th

485− return $ C.SinkResult [] Nothing

498+ return $ C.Processing

486 -- We pause timeouts before passing control back to user code. This ensures

499 -- We pause timeouts before passing control back to user code. This ensures

487 -- that a timeout will only ever be executed when Warp is in control. We

500 -- that a timeout will only ever be executed when Warp is in control. We

488 -- also make sure to resume the timeout after the completion of user code

501 -- also make sure to resume the timeout after the completion of user code

@@ -526,7 +539,7 @@ defaultSettings = Settings

526 go' (Just ThreadKilled) = False

539 go' (Just ThreadKilled) = False

527 go' _ = True

540 go' _ = True

528

541

529−takeHeaders :: C.Source IO ByteString -> ResourceT IO [ByteString]

542+takeHeaders :: C.BSource IO ByteString -> ResourceT IO [ByteString]

530takeHeaders src = do

543takeHeaders src = do

531 !x <- forceHead ConnectionClosedByPeer src

544 !x <- forceHead ConnectionClosedByPeer src

532 takeHeaders' 0 id id x src

545 takeHeaders' 0 id id x src

@@ -537,7 +550,7 @@ takeHeaders' :: Int

537 -> ([ByteString] -> [ByteString])

550 -> ([ByteString] -> [ByteString])

538 -> ([ByteString] -> [ByteString])

551 -> ([ByteString] -> [ByteString])

539 -> ByteString

552 -> ByteString

540− -> C.Source IO ByteString

553+ -> C.BSource IO ByteString

541 -> ResourceT IO [ByteString]

554 -> ResourceT IO [ByteString]

542takeHeaders' !len _ _ _ _ | len > maxTotalHeaderLength = throwIO OverLargeHeader

555takeHeaders' !len _ _ _ _ | len > maxTotalHeaderLength = throwIO OverLargeHeader

543takeHeaders' !len !lines !prepend !bs src = do

556takeHeaders' !len !lines !prepend !bs src = do

@@ -581,7 +594,7 @@ takeHeaders' !len !lines !prepend !bs src = do

581{-# INLINE takeHeaders' #-}

594{-# INLINE takeHeaders' #-}

582

595

583forceHead :: InvalidRequest

596forceHead :: InvalidRequest

584− -> C.Source IO ByteString

597+ -> C.BSource IO ByteString

585 -> ResourceT IO ByteString

598 -> ResourceT IO ByteString

586forceHead err src = do

599forceHead err src = do

587 !mx <- src C.$$ CL.head

600 !mx <- src C.$$ CL.head

warp/warp.cabal+2−2

@@ -1,5 +1,5 @@

1Name: warp

2−Version: 0.5.0

2+Version: 1.0.0

3Synopsis: A fast, light-weight web server for WAI applications.

4License: BSD3

5License-file: LICENSE

@@ -18,7 +18,7 @@ flag network-bytestring

18Library

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

20 , bytestring >= 0.9.1.4 && < 0.10

21− , wai >= 0.5 && < 0.6

21+ , wai >= 1.0 && < 1.1

22 , transformers >= 0.2.2 && < 0.3

23 , conduit >= 0.0 && < 0.1

24 , lifted-base >= 0.1 && < 0.2