wai-extra 0.2.0 → 0.2.1

raw patch · 3 files changed

+60/−15 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

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

@@ -2,6 +2,8 @@ module Network.Wai.Handler.CGI     ( run     , run'+    , run''+    , runSendfile     ) where  import Network.Wai@@ -27,14 +29,35 @@ run :: Application -> IO () run app = do     vars <- getEnvironment-    run' vars System.IO.stdin System.IO.stdout app+    let input = requestBodyHandle System.IO.stdin+        output = B.hPut System.IO.stdout+    run'' vars input output Nothing app +runSendfile :: String -- ^ sendfile header+            -> Application -> IO ()+runSendfile sf app = do+    vars <- getEnvironment+    let input = requestBodyHandle System.IO.stdin+        output = B.hPut System.IO.stdout+    run'' vars input output (Just sf) app+ run' :: [(String, String)] -- ^ all variables      -> System.IO.Handle -- ^ responseBody of input      -> System.IO.Handle -- ^ destination for output      -> Application      -> IO () run' vars inputH outputH app = do+    let input = requestBodyHandle inputH+        output = B.hPut outputH+    run'' vars input output Nothing app++run'' :: [(String, String)] -- ^ all variables+     -> (Int -> Source) -- ^ responseBody of input+     -> (B.ByteString -> IO ()) -- ^ destination for output+     -> Maybe String -- ^ does the server support the X-Sendfile header?+     -> Application+     -> IO ()+run'' vars inputH outputH xsendfile app = do     let rmethod = B.pack $ lookup' "REQUEST_METHOD" vars         pinfo = lookup' "PATH_INFO" vars         qstring = lookup' "QUERY_STRING" vars@@ -60,7 +83,7 @@             , serverPort = serverport             , requestHeaders = map (cleanupVarName *** B.pack) vars             , isSecure = isSecure'-            , requestBody = requestBodyHandle inputH contentLength+            , requestBody = inputH contentLength             , errorHandler = System.IO.hPutStr System.IO.stderr             , remoteHost = B.pack remoteHost'             , httpVersion = "1.1" -- FIXME@@ -71,17 +94,29 @@                 Nothing -> ("Content-Type", "text/html; charset=utf-8")                          : h                 Just _ -> h-    let hPut = B.hPut outputH+    let hPut = outputH     hPut $ B.pack $ "Status: " ++ (show $ statusCode $ status res) ++ " "     hPut $ statusMessage $ status res     hPut $ B.singleton '\n'     mapM_ (printHeader hPut) h'-    hPut $ B.singleton '\n'-    _ <- runEnumerator (fromResponseBody (responseBody res)) (myPut outputH) ()-    return ()+    case (xsendfile, responseBody res) of+        (Just sf, ResponseFile fp) ->+            hPut $ B.pack $ concat+                [ sf+                , ": "+                , fp+                , "\n\n"+                , sf+                , " not supported"+                ]+        _ -> do+            hPut $ B.singleton '\n'+            _ <- runEnumerator (fromResponseBody (responseBody res))+                               (myPut outputH) ()+            return () -myPut :: System.IO.Handle -> () -> B.ByteString -> IO (Either () ())-myPut outputH _ bs = B.hPut outputH bs >> return (Right ())+myPut :: (B.ByteString -> IO ()) -> () -> B.ByteString -> IO (Either () ())+myPut output _ bs = output bs >> return (Right ())  printHeader :: (B.ByteString -> IO ())             -> (ResponseHeader, B.ByteString)

@@ -1,5 +1,6 @@ module Network.Wai.Handler.Helper     ( requestBodyHandle+    , requestBodyFunc     ) where  import System.IO (Handle)@@ -8,8 +9,17 @@ import Network.Wai (Source (..))  requestBodyHandle :: Handle -> Int -> Source-requestBodyHandle _ 0 = Source $ return Nothing-requestBodyHandle h len = Source $ do-    bs <- B.hGet h $ min len defaultChunkSize-    let newLen = len - B.length bs-    return $ Just (bs, requestBodyHandle h newLen)+requestBodyHandle h =+    requestBodyFunc go+  where+    go i = Just `fmap` B.hGet h (min i defaultChunkSize)++requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> Source+requestBodyFunc _ 0 = Source $ return Nothing+requestBodyFunc h len = Source $ do+    mbs <- h len+    case mbs of+        Nothing -> return Nothing+        Just bs -> do+            let newLen = len - B.length bs+            return $ Just (bs, requestBodyFunc h $ max 0 newLen)

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             0.2.0+Version:             0.2.1 Synopsis:            Provides some basic WAI handlers and middleware. Description:         The goal here is to provide common features without many dependencies. License:             BSD3@@ -31,7 +31,7 @@                      Network.Wai.Middleware.Jsonp                      Network.Wai.Zlib                      Network.Wai.Parse-  Other-modules:     Network.Wai.Handler.Helper+                     Network.Wai.Handler.Helper   ghc-options:       -Wall   c-sources:         c/helper.c   include-dirs:      c