wai-app-file-cgi 0.5.7 → 0.5.8
raw patch · 5 files changed
+42/−37 lines, 5 filesdep +resourcetdep ~conduitdep ~http-conduitdep ~waiPVP ok
version bump matches the API change (PVP)
Dependencies added: resourcet
Dependency ranges changed: conduit, http-conduit, wai
API changes (from Hackage documentation)
Files
- Network/Wai/Application/Classic/CGI.hs +6/−7
- Network/Wai/Application/Classic/Conduit.hs +6/−4
- Network/Wai/Application/Classic/RevProxy.hs +8/−7
- test/Test.hs +15/−14
- wai-app-file-cgi.cabal +7/−5
Network/Wai/Application/Classic/CGI.hs view
@@ -4,7 +4,6 @@ cgiApp ) where -import Control.Applicative import Control.Exception (SomeException) import Control.Exception.Lifted (catch) import Control.Monad (when)@@ -72,15 +71,14 @@ fromCGI :: Handle -> ClassicAppSpec -> Application fromCGI rhdl cspec req = do- bsrc <- bufferSource $ CB.sourceHandle rhdl- m <- (check <$> (bsrc $$ parseHeader)) `catch` recover- let (st, hdr, hasBody) = case m of+ (src', hs) <- (CB.sourceHandle rhdl $$+ parseHeader) `catch` recover+ let (st, hdr, hasBody) = case check hs of Nothing -> (internalServerError500,[],False) Just (s,h) -> (s,h,True) hdr' = addServer cspec hdr liftIO $ logger cspec req st Nothing- let src = if hasBody then toSource bsrc else CL.sourceNull- return $ ResponseSource st hdr' (Chunk <$> src)+ let src = if hasBody then src' else CL.sourceNull+ return $ ResponseSource st hdr' (toResponseSource src) where check hs = lookup fkContentType hs >> case lookup "status" hs of Nothing -> Just (ok200, hs)@@ -88,7 +86,8 @@ where hs' = filter (\(k,_) -> k /= "status") hs toStatus s = BS.readInt s >>= \x -> Just (Status (fst x) s)- recover (_ :: SomeException) = return Nothing+ emptyHeader = []+ recover (_ :: SomeException) = return (CL.sourceNull, emptyHeader) ----------------------------------------------------------------
Network/Wai/Application/Classic/Conduit.hs view
@@ -2,7 +2,7 @@ module Network.Wai.Application.Classic.Conduit ( byteStringToBuilder- , toSource+ , toResponseSource , parseHeader ) where @@ -14,6 +14,7 @@ import Data.CaseInsensitive (CI(..), mk) import Data.Conduit import Data.Conduit.Attoparsec+import qualified Data.Conduit.List as CL import Data.Word import Network.HTTP.Types @@ -24,12 +25,13 @@ ---------------------------------------------------------------- -toSource :: BufferedSource IO ByteString -> Source IO Builder-toSource = fmap byteStringToBuilder . unbufferSource+toResponseSource :: Source (ResourceT IO) ByteString + -> Source (ResourceT IO) (Flush Builder)+toResponseSource = ($= CL.map (Chunk . byteStringToBuilder)) ---------------------------------------------------------------- -parseHeader :: Sink ByteString IO RequestHeaders+parseHeader :: Sink ByteString (ResourceT IO) RequestHeaders parseHeader = sinkParser parseHeader' parseHeader' :: Parser RequestHeaders
Network/Wai/Application/Classic/RevProxy.hs view
@@ -9,6 +9,7 @@ import qualified Data.ByteString.Char8 as BS hiding (uncons) import qualified Data.ByteString as BS (uncons) import Data.Conduit+import qualified Data.Conduit.List as CL import Data.Int import Data.Maybe import qualified Network.HTTP.Conduit as H@@ -20,7 +21,7 @@ import Network.Wai.Application.Classic.Types import Prelude hiding (catch) -toHTTPRequest :: Request -> RevProxyRoute -> Int64 -> H.Request IO+toHTTPRequest :: Request -> RevProxyRoute -> Int64 -> H.Request (ResourceT IO) toHTTPRequest req route len = H.def { H.host = revProxyDomain route , H.port = revProxyPort route@@ -45,10 +46,10 @@ Just (63, q') -> q' -- '?' is 63 _ -> q -getBody :: Request -> Int64 -> H.RequestBody IO+getBody :: Request -> Int64 -> H.RequestBody (ResourceT IO) getBody req len = H.RequestBodySource len (toBodySource req) where- toBodySource = (byteStringToBuilder <$>) . requestBody+ toBodySource r = requestBody r $= CL.map byteStringToBuilder getLen :: Request -> Maybe Int64 getLen req = do@@ -71,10 +72,10 @@ let mlen = getLen req len = fromMaybe 0 mlen httpReq = toHTTPRequest req route len- H.Response status hdr downbody <- http httpReq mgr+ H.Response status _ hdr downbody <- http httpReq mgr let hdr' = fixHeader hdr liftIO $ logger cspec req status (fromIntegral <$> mlen)- return $ ResponseSource status hdr' (Chunk . byteStringToBuilder <$> downbody)+ return $ ResponseSource status hdr' (toResponseSource downbody) where mgr = revProxyManager spec fixHeader = addVia cspec req . filter p@@ -82,9 +83,9 @@ p ("Content-Length", _) = False p _ = True -type Resp = ResourceT IO (H.Response (Source IO BS.ByteString))+type Resp = ResourceT IO (H.Response (Source (ResourceT IO) BS.ByteString)) -http :: H.Request IO -> H.Manager -> Resp+http :: H.Request (ResourceT IO) -> H.Manager -> Resp http req mgr = H.http req mgr badGateway :: ClassicAppSpec -> Request-> SomeException -> ResourceT IO Response
test/Test.hs view
@@ -4,6 +4,7 @@ import Control.Exception.Lifted import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Conduit import Network.HTTP.Conduit import qualified Network.HTTP.Types as H import Prelude hiding (catch)@@ -25,7 +26,7 @@ case_post :: Assertion case_post = do- Response _ _ bdy <- sendPOST url "foo bar.\nbaz!\n"+ Response _ _ _ bdy <- sendPOST url "foo bar.\nbaz!\n" ans <- BL.readFile "test/data/post" bdy @?= ans where@@ -33,7 +34,7 @@ case_post2 :: Assertion case_post2 = do- Response sc _ _ <- sendPOST url "foo bar.\nbaz!\n"+ Response sc _ _ _ <- sendPOST url "foo bar.\nbaz!\n" sc @?= H.internalServerError500 where url = "http://localhost:8080/cgi-bin/broken"@@ -53,7 +54,7 @@ case_get2 :: Assertion case_get2 = do req <- parseUrl url- Response sc _ _ <- safeHttpLbs req+ Response sc _ _ _ <- safeHttpLbs req sc @?= H.notFound404 where url = "http://localhost:8080/dummy"@@ -62,7 +63,7 @@ case_get_ja :: Assertion case_get_ja = do- Response _ _ bdy <- sendGET url [("Accept-Language", "ja, en;q=0.7")]+ Response _ _ _ bdy <- sendGET url [("Accept-Language", "ja, en;q=0.7")] ans <- BL.readFile "test/html/ja/index.html.ja" bdy @?= ans where@@ -72,9 +73,9 @@ case_get_modified :: Assertion case_get_modified = do- Response _ hdr _ <- sendGET url []+ Response _ _ hdr _ <- sendGET url [] let Just lm = lookup "Last-Modified" hdr- Response sc _ _ <- sendGET url [("If-Modified-Since", lm)]+ Response sc _ _ _ <- sendGET url [("If-Modified-Since", lm)] sc @?= H.notModified304 where url = "http://localhost:8080/"@@ -83,7 +84,7 @@ case_get_partial :: Assertion case_get_partial = do- Response _ _ bdy <- sendGET url [("Range", "bytes=10-20")]+ Response _ _ _ bdy <- sendGET url [("Range", "bytes=10-20")] bdy @?= ans where url = "http://localhost:8080/"@@ -93,7 +94,7 @@ case_head :: Assertion case_head = do- Response sc _ _ <- sendHEAD url []+ Response sc _ _ _ <- sendHEAD url [] sc @?= H.ok200 where url = "http://localhost:8080/"@@ -102,7 +103,7 @@ case_head2 :: Assertion case_head2 = do- Response sc _ _ <- sendHEAD url []+ Response sc _ _ _ <- sendHEAD url [] sc @?= H.notFound404 where url = "http://localhost:8080/dummy"@@ -111,7 +112,7 @@ case_head_ja :: Assertion case_head_ja = do- Response sc _ _ <- sendHEAD url [("Accept-Language", "ja, en;q=0.7")]+ Response sc _ _ _ <- sendHEAD url [("Accept-Language", "ja, en;q=0.7")] sc @?= H.ok200 where url = "http://localhost:8080/ja/"@@ -120,9 +121,9 @@ case_head_modified :: Assertion case_head_modified = do- Response _ hdr _ <- sendHEAD url []+ Response _ _ hdr _ <- sendHEAD url [] let Just lm = lookup "Last-Modified" hdr- Response sc _ _ <- sendHEAD url [("If-Modified-Since", lm)]+ Response sc _ _ _ <- sendHEAD url [("If-Modified-Since", lm)] sc @?= H.notModified304 where url = "http://localhost:8080/"@@ -170,11 +171,11 @@ ---------------------------------------------------------------- -safeHttpLbs :: Request IO -> IO (Response BL.ByteString)+safeHttpLbs :: Request (ResourceT IO) -> IO (Response BL.ByteString) safeHttpLbs req = withManager (httpLbs req) `catch` httpHandler ---------------------------------------------------------------- httpHandler :: HttpException -> IO (Response BL.ByteString)-httpHandler (StatusCodeException sc hd) = return (Response sc hd BL.empty)+httpHandler (StatusCodeException sc hd) = return (Response sc H.http11 hd BL.empty) httpHandler _ = error "handler"
wai-app-file-cgi.cabal view
@@ -1,5 +1,5 @@ Name: wai-app-file-cgi-Version: 0.5.7+Version: 0.5.8 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -36,21 +36,22 @@ , blaze-builder , bytestring , case-insensitive- , conduit >= 0.2 && < 0.3+ , conduit >= 0.4 && < 0.5 , containers , directory , filepath- , http-conduit >= 1.2 && < 1.3+ , http-conduit , http-date , http-types >= 0.6.9 , io-choice , lifted-base , network , process+ , resourcet , static-hash , transformers , unix- , wai >= 1.1+ , wai >= 1.2 , wai-app-static >= 0.3 , wai-logger @@ -60,7 +61,8 @@ HS-Source-Dirs: test Build-Depends: base >= 4 && < 5 , bytestring- , http-conduit >= 1.2 && < 1.3+ , conduit >= 0.4 && < 0.5+ , http-conduit , http-types , lifted-base , HUnit