8e425fd · typeable/wai

git.iko.soy/typeable/wai

Providing run'' for fastcgi

commit8e425fdae7f2f876bfb092f3c99c7dcc83ec4f37 authorMichael Snoyman <michael@snoyman.com> dateTue 27 Jul 2010, 17:55 (16 years ago) parent9eb76d3

3 files changed+32−11

compare with master

unifiedsplit

Network/Wai/Handler/CGI.hs+15−4 Network/Wai/Handler/Helper.hs+15−5 wai-extra.cabal+2−2

Network/Wai/Handler/CGI.hs+15−4

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

22module Network.Wai.Handler.CGI

33 ( run

44 , run'

5+ , run''

56 ) where

78import Network.Wai

@@ -35,6 +36,16 @@ run' :: [(String, String)] -- ^ all variables

3536 -> Application

3637 -> IO ()

3738run' vars inputH outputH app = do

39+ let input = requestBodyHandle inputH

40+ output = B.hPut outputH

41+ run'' vars input output app

42+

43+run'' :: [(String, String)] -- ^ all variables

44+ -> (Int -> Source) -- ^ responseBody of input

45+ -> (B.ByteString -> IO ()) -- ^ destination for output

46+ -> Application

47+ -> IO ()

48+run'' vars inputH outputH app = do

3849 let rmethod = B.pack $ lookup' "REQUEST_METHOD" vars

3950 pinfo = lookup' "PATH_INFO" vars

4051 qstring = lookup' "QUERY_STRING" vars

@@ -60,7 +71,7 @@ run' vars inputH outputH app = do

6071 , serverPort = serverport

6172 , requestHeaders = map (cleanupVarName *** B.pack) vars

6273 , isSecure = isSecure'

63− , requestBody = requestBodyHandle inputH contentLength

74+ , requestBody = inputH contentLength

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

6576 , remoteHost = B.pack remoteHost'

6677 , httpVersion = "1.1" -- FIXME

@@ -71,7 +82,7 @@ run' vars inputH outputH app = do

7182 Nothing -> ("Content-Type", "text/html; charset=utf-8")

7283 : h

7384 Just _ -> h

74− let hPut = B.hPut outputH

85+ let hPut = outputH

7586 hPut $ B.pack $ "Status: " ++ (show $ statusCode $ status res) ++ " "

7687 hPut $ statusMessage $ status res

7788 hPut $ B.singleton '\n'

@@ -80,8 +91,8 @@ run' vars inputH outputH app = do

8091 _ <- runEnumerator (fromResponseBody (responseBody res)) (myPut outputH) ()

8192 return ()

8293

83−myPut :: System.IO.Handle -> () -> B.ByteString -> IO (Either () ())

84−myPut outputH _ bs = B.hPut outputH bs >> return (Right ())

94+myPut :: (B.ByteString -> IO ()) -> () -> B.ByteString -> IO (Either () ())

95+myPut output _ bs = output bs >> return (Right ())

8596

8697printHeader :: (B.ByteString -> IO ())

8798 -> (ResponseHeader, B.ByteString)

Network/Wai/Handler/Helper.hs+15−5

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

11module Network.Wai.Handler.Helper

22 ( requestBodyHandle

3+ , requestBodyFunc

34 ) where

56import System.IO (Handle)

@@ -8,8 +9,17 @@ import Data.ByteString.Lazy.Internal (defaultChunkSize)

89import Network.Wai (Source (..))

910

1011requestBodyHandle :: Handle -> Int -> Source

11−requestBodyHandle _ 0 = Source $ return Nothing

12−requestBodyHandle h len = Source $ do

13− bs <- B.hGet h $ min len defaultChunkSize

14− let newLen = len - B.length bs

15− return $ Just (bs, requestBodyHandle h newLen)

12+requestBodyHandle h =

13+ requestBodyFunc go

14+ where

15+ go = Just `fmap` B.hGet h defaultChunkSize

16+

17+requestBodyFunc :: IO (Maybe B.ByteString) -> Int -> Source

18+requestBodyFunc _ 0 = Source $ return Nothing

19+requestBodyFunc h len = Source $ do

20+ mbs <- h

21+ case mbs of

22+ Nothing -> return Nothing

23+ Just bs -> do

24+ let newLen = len - B.length bs

25+ return $ Just (bs, requestBodyFunc h $ max 0 newLen)

wai-extra.cabal+2−2

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

11Name: wai-extra

2−Version: 0.2.0

2+Version: 0.2.1

33Synopsis: Provides some basic WAI handlers and middleware.

44Description: The goal here is to provide common features without many dependencies.

55License: BSD3

@@ -31,7 +31,7 @@ Library

3131 Network.Wai.Middleware.Jsonp

3232 Network.Wai.Zlib

3333 Network.Wai.Parse

34− Other-modules: Network.Wai.Handler.Helper

34+ Network.Wai.Handler.Helper

3535 ghc-options: -Wall

3636 c-sources: c/helper.c

3737 include-dirs: c