diff --git a/Network/Wai/Application/Classic/CGI.hs b/Network/Wai/Application/Classic/CGI.hs --- a/Network/Wai/Application/Classic/CGI.hs +++ b/Network/Wai/Application/Classic/CGI.hs @@ -4,9 +4,8 @@ cgiApp ) where -import Blaze.ByteString.Builder (Builder) -import qualified Control.Exception as E (SomeException, IOException, try, catch) -import Control.Monad (when) +import qualified Control.Exception as E (SomeException, IOException, try, catch, bracket) +import Control.Monad (when, (<=<)) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS (readInt, unpack, tail) import Data.Conduit @@ -15,6 +14,7 @@ import Network.HTTP.Types import Network.SockAddr import Network.Wai +import Network.Wai.Conduit import Network.Wai.Application.Classic.Conduit import Network.Wai.Application.Classic.Field import Network.Wai.Application.Classic.Header @@ -41,15 +41,15 @@ > installHandler sigCHLD Ignore Nothing -} cgiApp :: ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Application -cgiApp cspec spec cgii req = case method of - Right GET -> cgiApp' False cspec spec cgii req - Right POST -> cgiApp' True cspec spec cgii req - _ -> return $ responseLBS methodNotAllowed405 textPlainHeader "Method Not Allowed\r\n" -- xxx +cgiApp cspec spec cgii req respond = case method of + Right GET -> cgiApp' False cspec spec cgii req respond + Right POST -> cgiApp' True cspec spec cgii req respond + _ -> respond $ responseLBS methodNotAllowed405 textPlainHeader "Method Not Allowed\r\n" -- xxx where method = parseMethod $ requestMethod req cgiApp' :: Bool -> ClassicAppSpec -> CgiAppSpec -> CgiRoute -> Application -cgiApp' body cspec spec cgii req = responseSourceBracket setup teardown cgi +cgiApp' body cspec spec cgii req respond = E.bracket setup teardown (respond <=< cgi) where setup = execProcess cspec spec cgii req teardown (rhdl,whdl,pid) = do @@ -66,9 +66,9 @@ type TRYPATH = Either E.IOException String toCGI :: Handle -> Request -> IO () -toCGI whdl req = requestBody req $$ CB.sinkHandle whdl +toCGI whdl req = sourceRequestBody req $$ CB.sinkHandle whdl -fromCGI :: Handle -> ClassicAppSpec -> Request -> IO (Status, RequestHeaders, Source IO (Flush Builder)) +fromCGI :: Handle -> ClassicAppSpec -> Request -> IO Response fromCGI rhdl cspec req = do (src', hs) <- cgiHeader `E.catch` recover let (st, hdr, hasBody) = case check hs of @@ -78,7 +78,7 @@ logger cspec req st Nothing let src | hasBody = src' | otherwise = CL.sourceNull - return (st, hdr', src) + return $ responseSource st hdr' src where check hs = lookup hContentType hs >> case lookup hStatus hs of Nothing -> Just (ok200, hs) diff --git a/Network/Wai/Application/Classic/Conduit.hs b/Network/Wai/Application/Classic/Conduit.hs --- a/Network/Wai/Application/Classic/Conduit.hs +++ b/Network/Wai/Application/Classic/Conduit.hs @@ -9,7 +9,7 @@ import Blaze.ByteString.Builder (Builder) import qualified Blaze.ByteString.Builder as BB (fromByteString) import Control.Applicative -import Data.Attoparsec +import Data.Attoparsec.ByteString import Data.ByteString (ByteString) import Data.CaseInsensitive (CI(..), mk) import Data.Conduit diff --git a/Network/Wai/Application/Classic/File.hs b/Network/Wai/Application/Classic/File.hs --- a/Network/Wai/Application/Classic/File.hs +++ b/Network/Wai/Application/Classic/File.hs @@ -57,7 +57,7 @@ -} fileApp :: ClassicAppSpec -> FileAppSpec -> FileRoute -> Application -fileApp cspec spec filei req = do +fileApp cspec spec filei req respond = do RspSpec st body <- case method of Right GET -> processGET hinfo ishtml rfile Right HEAD -> processHEAD hinfo ishtml rfile @@ -67,8 +67,8 @@ BodyStatus -> bodyStatus st BodyFileNoBody hdr -> bodyFileNoBody st hdr BodyFile hdr afile rng -> bodyFile st hdr afile rng - liftIO $ logger cspec req st mlen - return response + logger cspec req st mlen + respond response where reqidx = indexRequestHeader (requestHeaders req) hinfo = HandlerInfo spec req reqidx file langs diff --git a/Network/Wai/Application/Classic/Redirect.hs b/Network/Wai/Application/Classic/Redirect.hs --- a/Network/Wai/Application/Classic/Redirect.hs +++ b/Network/Wai/Application/Classic/Redirect.hs @@ -4,7 +4,6 @@ redirectApp ) where -import Control.Monad.IO.Class (liftIO) import Data.ByteString.Char8 import Network.HTTP.Types import Network.Wai @@ -13,9 +12,9 @@ import Network.Wai.Application.Classic.Types redirectApp :: ClassicAppSpec -> RedirectRoute -> Application -redirectApp cspec route req = do - liftIO $ logger cspec req status Nothing - return $ responseLBS status hdr "" +redirectApp cspec route req respond = do + logger cspec req status Nothing + respond $ responseLBS status hdr "" where path = fromByteString $ rawPathInfo req src = redirectSrc route diff --git a/Network/Wai/Application/Classic/RevProxy.hs b/Network/Wai/Application/Classic/RevProxy.hs --- a/Network/Wai/Application/Classic/RevProxy.hs +++ b/Network/Wai/Application/Classic/RevProxy.hs @@ -4,6 +4,7 @@ import Blaze.ByteString.Builder (Builder) import Control.Applicative +import Control.Exception (bracket) import Control.Monad import Control.Monad.IO.Class (liftIO) import Data.ByteString (ByteString) @@ -12,9 +13,8 @@ import Data.Conduit import Data.Default.Class import qualified Network.HTTP.Client as H -import qualified Network.HTTP.Conduit as H import Network.HTTP.Types -import Network.Wai +import Network.Wai.Conduit import Network.Wai.Application.Classic.Conduit import Network.Wai.Application.Classic.EventSource import Network.Wai.Application.Classic.Field @@ -27,7 +27,7 @@ -- | Relaying any requests as reverse proxy. revProxyApp :: ClassicAppSpec -> RevProxyAppSpec -> RevProxyRoute -> Application -revProxyApp cspec spec route req = responseSourceBracket setup teardown proxy +revProxyApp cspec spec route req respond = bracket setup teardown proxy where setup = H.responseOpen httpClientRequest mgr teardown = H.responseClose @@ -38,7 +38,7 @@ ct = lookup hContentType hdr src = toSource ct clientBody logger cspec req status (fromIntegral <$> mlen) - return (status, hdr, src) + respond $ responseSource status hdr src httpClientRequest = reqToHReq req route mgr = revProxyManager spec @@ -86,9 +86,9 @@ Just (63, q') -> q' -- '?' is 63 _ -> q -bodyToHBody :: RequestBodyLength -> Source IO ByteString -> H.RequestBody -bodyToHBody ChunkedBody src = H.requestBodySourceChunkedIO src -bodyToHBody (KnownLength len) src = H.requestBodySourceIO (fromIntegral len) src +bodyToHBody :: RequestBodyLength -> IO ByteString -> H.RequestBody +bodyToHBody ChunkedBody src = H.RequestBodyStreamChunked ($ src) +bodyToHBody (KnownLength len) src = H.RequestBodyStream (fromIntegral len) ($ src) ---------------------------------------------------------------- diff --git a/wai-app-file-cgi.cabal b/wai-app-file-cgi.cabal --- a/wai-app-file-cgi.cabal +++ b/wai-app-file-cgi.cabal @@ -1,5 +1,5 @@ Name: wai-app-file-cgi -Version: 2.0.5 +Version: 3.0.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -61,7 +61,8 @@ , text , transformers , unix - , wai >= 2.0 && < 3.0 + , wai >= 3.0 && < 3.1 + , wai-conduit , word8 Test-Suite doctest