b407d2a · typeable/wai

Network/Wai.hs+5−1

compare with master

unifiedsplit

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

1{-# LANGUAGE Rank2Types #-}

2+{-# LANGUAGE ExistentialQuantification #-}

2{-|

3{-|

3

4

4This module defines a generic web application interface. It is a common

5This module defines a generic web application interface. It is a common

@@ -56,6 +57,7 @@ module Network.Wai

56 , statusCode

57 , statusCode

57 , statusMessage

58 , statusMessage

58 -- * Enumerator

59 -- * Enumerator

60+ , Source (..)

59 , Enumerator (..)

61 , Enumerator (..)

60 -- * WAI interface

62 -- * WAI interface

61 , Request (..)

63 , Request (..)

@@ -308,6 +310,8 @@ statusMessage Status405 = B8.pack "Method Not Allowed"

308statusMessage Status500 = B8.pack "Internal Server Error"

310statusMessage Status500 = B8.pack "Internal Server Error"

309statusMessage (Status _ m) = m

311statusMessage (Status _ m) = m

310

312

313+data Source = forall a. Source a (a -> IO (Maybe (B.ByteString, a)))

314+

311-- | An enumerator is a data producer. It takes two arguments: a function to

315-- | An enumerator is a data producer. It takes two arguments: a function to

312-- enumerate over (the iteratee) and an accumulating parameter. As the

316-- enumerate over (the iteratee) and an accumulating parameter. As the

313-- enumerator produces output, it calls the iteratee, thereby avoiding the need

317-- enumerator produces output, it calls the iteratee, thereby avoiding the need

@@ -363,7 +367,7 @@ data Request = Request

363 , serverPort :: Int

367 , serverPort :: Int

364 , requestHeaders :: [(RequestHeader, B.ByteString)]

368 , requestHeaders :: [(RequestHeader, B.ByteString)]

365 , urlScheme :: UrlScheme

369 , urlScheme :: UrlScheme

366− , requestBody :: Enumerator

370+ , requestBody :: Source

367 , errorHandler :: String -> IO ()

371 , errorHandler :: String -> IO ()

368 -- | The client\'s host information.

372 -- | The client\'s host information.

369 , remoteHost :: B.ByteString

373 , remoteHost :: B.ByteString

Network/Wai/Handler/SimpleServer.hs+9−13

@@ -128,23 +128,19 @@ parseRequest port lines' handle remoteHost' = do

128 , serverPort = port

129 , requestHeaders = heads

130 , urlScheme = HTTP

131− , requestBody = requestBodyHandle handle len

131+ , requestBody = Source len $ requestBodyHandle handle

132 , errorHandler = System.IO.hPutStr System.IO.stderr

133 , remoteHost = B8.pack remoteHost'

134 }

135

136−requestBodyHandle :: Handle -> Int -> Enumerator

136+requestBodyHandle :: Handle -> Int -> IO (Maybe (B8.ByteString, Int))

137−requestBodyHandle h len0 = Enumerator $ helper len0 where

137+requestBodyHandle _ 0 = return Nothing

138− helper 0 _ a = return $ Right a

138+requestBodyHandle h len = do

139− helper len iter a = do

140− let maxChunkSize = 1024

139+ let maxChunkSize = 1024

141− bs <- BS.hGet h $ min len maxChunkSize

140+ bs <- BS.hGet h $ min len maxChunkSize

142− let newLen = len - BS.length bs

141+ let newLen = len - BS.length bs

143− putStrLn $ "reading a chunk of size " ++ show (BS.length bs)

142+ putStrLn $ "reading a chunk of size " ++ show (BS.length bs)

144− ea' <- iter a bs

143+ return $ Just (bs, newLen)

145− case ea' of

146− Left a' -> return $ Left a'

147− Right a' -> helper newLen iter a'

148

144

149parseFirst :: (StringLike s, MonadFailure InvalidRequest m) =>

145parseFirst :: (StringLike s, MonadFailure InvalidRequest m) =>

150 s

146 s

Network/Wai/Source.hsnew file+30

@@ -0,0 +1,30 @@

1+module Network.Wai.Source

2+ ( toEnumerator

3+ , toLBS

4+ ) where

5+

6+import Network.Wai

7+import qualified Data.ByteString.Lazy as L

8+import System.IO.Unsafe (unsafeInterleaveIO)

9+

10+toEnumerator :: Source -> Enumerator

11+toEnumerator (Source b0 source) = Enumerator $ helper b0 where

12+ helper b iter a = do

13+ next <- source b

14+ case next of

15+ Nothing -> return $ Right a

16+ Just (bs, b') -> do

17+ res <- iter a bs

18+ case res of

19+ Left a' -> return $ Left a'

20+ Right a' -> helper b' iter a'

21+

22+toLBS :: Source -> IO L.ByteString

23+toLBS (Source b0 source) = L.fromChunks `fmap` helper b0 where

24+ helper b = unsafeInterleaveIO $ do

25+ next <- source b

26+ case next of

27+ Nothing -> return []

28+ Just (bs, b') -> do

29+ rest <- helper b'

30+ return $ bs : rest

lazy-test.hs+3−2

@@ -1,6 +1,7 @@

1{-# LANGUAGE Rank2Types #-}

2import Network.Wai

3import Network.Wai.Enumerator

4+import qualified Network.Wai.Source as Source

4import Network.Wai.Handler.SimpleServer

5import Network.Wai.Handler.SimpleServer

5import qualified Data.ByteString.Char8 as B8

6import qualified Data.ByteString.Char8 as B8

6

7

@@ -19,11 +20,11 @@ indexResponse = return Response

19 , responseBody = index

20 , responseBody = index

20 }

21 }

21

22

22−postResponse :: Enumerator -> IO Response

23+postResponse :: Source -> IO Response

23postResponse rb = return Response

24postResponse rb = return Response

24 { status = Status200

25 { status = Status200

25 , responseHeaders = [(ContentType, B8.pack "text/plain")]

26 , responseHeaders = [(ContentType, B8.pack "text/plain")]

26− , responseBody = Right $ fromLBS' $ toLBS rb

27+ , responseBody = Right $ fromLBS' $ Source.toLBS rb

27 }

28 }

28

29

29index :: Either FilePath a

30index :: Either FilePath a

test.hs+2−1

@@ -2,13 +2,14 @@

2import Network.Wai

3import Network.Wai.Handler.SimpleServer

4import qualified Data.ByteString.Char8 as B8

5+import qualified Network.Wai.Source as Source

5

6

6main :: IO ()

7main :: IO ()

7main = putStrLn "http://localhost:3000/" >> run 3000 app

8main = putStrLn "http://localhost:3000/" >> run 3000 app

8

9

9app :: Application

10app :: Application

10app req = case B8.unpack $ pathInfo req of

11app req = case B8.unpack $ pathInfo req of

11− "/post/" -> postResponse $ requestBody req

12+ "/post/" -> postResponse $ Source.toEnumerator $ requestBody req

12 _ -> indexResponse

13 _ -> indexResponse

13

14

14indexResponse :: IO Response

15indexResponse :: IO Response

wai.cabal+1

@@ -17,4 +17,5 @@ Library

17 bytestring >= 0.9 && < 0.10

18 Exposed-modules: Network.Wai

19 Network.Wai.Enumerator

20+ Network.Wai.Source

20 ghc-options: -Wall

21 ghc-options: -Wall