wai-app-file-cgi 0.8.3 → 0.8.4
raw patch · 9 files changed
+94/−80 lines, 9 filesdep +HTTPdep ~http-conduitPVP ok
version bump matches the API change (PVP)
Dependencies added: HTTP
Dependency ranges changed: http-conduit
API changes (from Hackage documentation)
Files
- Network/Wai/Application/Classic.hs +7/−1
- Network/Wai/Application/Classic/CGI.hs +2/−3
- Network/Wai/Application/Classic/EventSource.hs +4/−2
- Network/Wai/Application/Classic/File.hs +0/−1
- Network/Wai/Application/Classic/RevProxy.hs +2/−3
- Network/Wai/Application/Classic/Status.hs +0/−2
- Network/Wai/Application/Classic/Types.hs +7/−1
- test/ClassicSpec.hs +58/−63
- wai-app-file-cgi.cabal +14/−4
Network/Wai/Application/Classic.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {-| WAI (Web Application Interface) Application for static files and CGI. -}@@ -21,10 +23,12 @@ , defaultCgiAppSpec , CgiRoute(..) , cgiApp+#ifdef REV_PROXY -- * Reverse Proxy , RevProxyAppSpec(..) , RevProxyRoute(..) , revProxyApp+#endif -- * Path , module Network.Wai.Application.Classic.Path -- * Misc@@ -35,6 +39,8 @@ import Network.Wai.Application.Classic.File import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Redirect-import Network.Wai.Application.Classic.RevProxy import Network.Wai.Application.Classic.Types import Network.Wai.Application.Classic.Def+#ifdef REV_PROXY+import Network.Wai.Application.Classic.RevProxy+#endif
Network/Wai/Application/Classic/CGI.hs view
@@ -5,7 +5,7 @@ ) where import Control.Exception (SomeException, IOException, try)-import Control.Exception.Lifted (catch)+import Control.Exception.Lifted as L (catch) import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource@@ -23,7 +23,6 @@ import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types import Network.Wai.Logger.Utils-import Prelude hiding (catch) import System.Environment import System.IO import System.Process@@ -74,7 +73,7 @@ fromCGI :: Handle -> ClassicAppSpec -> Application fromCGI rhdl cspec req = do- (src', hs) <- cgiHeader `catch` recover+ (src', hs) <- cgiHeader `L.catch` recover let (st, hdr, hasBody) = case check hs of Nothing -> (internalServerError500,[],False) Just (s,h) -> (s,h,True)
Network/Wai/Application/Classic/EventSource.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE OverloadedStrings #-}+ module Network.Wai.Application.Classic.EventSource (- toResponseEventSource-) where+ toResponseEventSource+ ) where import Blaze.ByteString.Builder import Data.ByteString (ByteString) import qualified Data.ByteString as BS+import Data.ByteString.Char8 () import Data.Conduit import qualified Data.Conduit.List as CL
Network/Wai/Application/Classic/File.hs view
@@ -19,7 +19,6 @@ import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Status import Network.Wai.Application.Classic.Types-import Prelude hiding (catch) ----------------------------------------------------------------
Network/Wai/Application/Classic/RevProxy.hs view
@@ -4,7 +4,7 @@ import Control.Applicative import Control.Exception (SomeException)-import Control.Exception.Lifted (catch)+import Control.Exception.Lifted as L (catch) import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString.Char8 as BS hiding (uncons) import qualified Data.ByteString as BS (uncons)@@ -21,7 +21,6 @@ import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types import Blaze.ByteString.Builder (Builder)-import Prelude hiding (catch) toHTTPRequest :: Request -> RevProxyRoute -> Int64 -> H.Request (ResourceT IO) toHTTPRequest req route len = H.def {@@ -67,7 +66,7 @@ revProxyApp :: ClassicAppSpec -> RevProxyAppSpec -> RevProxyRoute -> Application revProxyApp cspec spec route req = revProxyApp' cspec spec route req- `catch` badGateway cspec req+ `L.catch` badGateway cspec req revProxyApp' :: ClassicAppSpec -> RevProxyAppSpec -> RevProxyRoute -> Application revProxyApp' cspec spec route req = do
Network/Wai/Application/Classic/Status.hs view
@@ -8,12 +8,10 @@ import Control.Exception.IOChoice import qualified Data.ByteString.Lazy as BL import Data.ByteString.Lazy.Char8 ()-import Data.Maybe import qualified Data.StaticHash as M import Network.HTTP.Types import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types-import Prelude hiding (catch) ----------------------------------------------------------------
Network/Wai/Application/Classic/Types.hs view
@@ -1,13 +1,17 @@+{-# LANGUAGE CPP #-}+ module Network.Wai.Application.Classic.Types where import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)-import qualified Network.HTTP.Conduit as H import Network.HTTP.Date import Network.HTTP.Types import Network.Wai.Application.Classic.Path import Network.Wai.Logger import System.Log.FastLogger+#ifdef REV_PROXY+import qualified Network.HTTP.Conduit as H+#endif ---------------------------------------------------------------- @@ -81,6 +85,7 @@ ---------------------------------------------------------------- +#ifdef REV_PROXY data RevProxyAppSpec = RevProxyAppSpec { -- | Connection manager revProxyManager :: H.Manager@@ -96,6 +101,7 @@ -- | Destination port number. , revProxyPort :: Int } deriving (Eq,Show)+#endif ----------------------------------------------------------------
test/ClassicSpec.hs view
@@ -3,11 +3,9 @@ module ClassicSpec where import Control.Applicative-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)+import Network.HTTP+import Network.Stream+import System.IO import Test.Hspec spec :: Spec@@ -15,95 +13,92 @@ describe "cgiApp" $ do it "accepts POST" $ do let url = "http://127.0.0.1:2345/cgi-bin/echo-env/pathinfo?query=foo"- bdy <- responseBody <$> sendPOST url "foo bar.\nbaz!\n"- ans <- BL.readFile "test/data/post"+ bdy <- rspBody <$> sendPOST url "foo bar.\nbaz!\n"+ ans <- readFileAscii "test/data/post" bdy `shouldBe` ans it "causes 500 if the CGI script does not exist" $ do let url = "http://127.0.0.1:2345/cgi-bin/broken"- sc <- responseStatus <$> sendPOST url "foo bar.\nbaz!\n"- sc `shouldBe` H.internalServerError500-+ sc <- rspCode <$> sendPOST url "foo bar.\nbaz!\n"+ sc `shouldBe` (5,0,0) describe "fileApp" $ do it "returns index.html for /" $ do let url = "http://127.0.0.1:2345/"- rsp <- simpleHttp url- ans <- BL.readFile "test/html/index.html"- rsp `shouldBe` ans+ bdy <- rspBody <$> sendGET url+ ans <- readFileAscii "test/html/index.html"+ bdy `shouldBe` ans it "returns 400 if not exist" $ do let url = "http://127.0.0.1:2345/dummy"- req <- parseUrl url- sc <- responseStatus <$> safeHttpLbs req- sc `shouldBe` H.notFound404+ sc <- rspCode <$> sendGET url+ sc `shouldBe` (4,0,4) it "returns Japanese HTML if language is specified" $ do let url = "http://127.0.0.1:2345/ja/"- bdy <- responseBody <$> sendGET url [("Accept-Language", "ja, en;q=0.7")]- ans <- BL.readFile "test/html/ja/index.html.ja"+ bdy <- rspBody <$> sendGETwH url [Header HdrAcceptLanguage "ja, en;q=0.7"]+ ans <- readFileAscii "test/html/ja/index.html.ja" bdy `shouldBe` ans it "returns 304 if not changed" $ do let url = "http://127.0.0.1:2345/"- hdr <- responseHeaders <$> sendGET url []- let Just lm = lookup "Last-Modified" hdr- sc <- responseStatus <$> sendGET url [("If-Modified-Since", lm)]- sc `shouldBe` H.notModified304+ hdr <- rspHeaders <$> sendGET url+ let Just lm = lookupHeader HdrLastModified hdr+ sc <- rspCode <$> sendGETwH url [Header HdrIfModifiedSince lm]+ sc `shouldBe` (3,0,4) it "can handle partial request" $ do let url = "http://127.0.0.1:2345/" ans = "html>\n<html"- bdy <- responseBody <$> sendGET url [("Range", "bytes=10-20")]+ bdy <- rspBody <$> sendGETwH url [Header HdrRange "bytes=10-20"] bdy `shouldBe` ans it "can handle HEAD" $ do let url = "http://127.0.0.1:2345/"- sc <- responseStatus <$> sendHEAD url []- sc `shouldBe` H.ok200+ sc <- rspCode <$> sendHEAD url+ sc `shouldBe` (2,0,0) it "returns 404 for HEAD if not exist" $ do let url = "http://127.0.0.1:2345/dummy"- sc <- responseStatus <$> sendHEAD url []- sc `shouldBe` H.notFound404+ sc <- rspCode <$> sendHEAD url+ sc `shouldBe` (4,0,4) it "can handle HEAD even if language is specified" $ do let url = "http://127.0.0.1:2345/ja/"- sc <- responseStatus <$> sendHEAD url [("Accept-Language", "ja, en;q=0.7")]- sc `shouldBe` H.ok200+ sc <- rspCode <$> sendHEADwH url [Header HdrAcceptLanguage "ja, en;q=0.7"]+ sc `shouldBe` (2,0,0) it "returns 304 for HEAD if not modified" $ do let url = "http://127.0.0.1:2345/"- hdr <- responseHeaders <$> sendHEAD url []- let Just lm = lookup "Last-Modified" hdr- sc <- responseStatus <$> sendHEAD url [("If-Modified-Since", lm)]- sc `shouldBe` H.notModified304+ hdr <- rspHeaders <$> sendHEAD url+ let Just lm = lookupHeader HdrLastModified hdr+ sc <- rspCode <$> sendHEADwH url [Header HdrIfModifiedSince lm]+ sc `shouldBe` (3,0,4) it "redirects to dir/ if trailing slash is missing" $ do let url = "http://127.0.0.1:2345/redirect"- rsp <- simpleHttp url- ans <- BL.readFile "test/html/redirect/index.html"- rsp `shouldBe` ans-+ rsp <- sendGET url+ let sc = rspCode rsp+ hdr = rspHeaders rsp+ Just lm = lookupHeader HdrLocation hdr+ sc `shouldBe` (3,0,1)+ lm `shouldBe` "http://127.0.0.1:2345/redirect/" ---------------------------------------------------------------- -sendGET ::String -> H.RequestHeaders -> IO (Response BL.ByteString)-sendGET url hdr = do- req' <- parseUrl url- let req = req' { requestHeaders = hdr }- safeHttpLbs req+sendGET :: String -> IO (Response String)+sendGET url = sendGETwH url [] -sendHEAD :: String -> H.RequestHeaders -> IO (Response BL.ByteString)-sendHEAD url hdr = do- req' <- parseUrl url- let req = req' {- requestHeaders = hdr- , method = "HEAD"- }- safeHttpLbs req+sendGETwH :: String -> [Header] -> IO (Response String)+sendGETwH url hdr = unResult $ simpleHTTP $ (getRequest url) { rqHeaders = hdr } -sendPOST :: String -> BL.ByteString -> IO (Response BL.ByteString)-sendPOST url body = do- req' <- parseUrl url- let req = req' {- method = "POST"- , requestBody = RequestBodyLBS body- }- safeHttpLbs req+sendHEAD :: String -> IO (Response String)+sendHEAD url = sendHEADwH url [] -----------------------------------------------------------------+sendHEADwH :: String -> [Header] -> IO (Response String)+sendHEADwH url hdr = unResult $ simpleHTTP $ (headRequest url) { rqHeaders = hdr } -safeHttpLbs :: Request (ResourceT IO) -> IO (Response BL.ByteString)-safeHttpLbs req = withManager $ httpLbs req {- checkStatus = \_ _ _ -> Nothing -- prevent throwing an error- }+sendPOST :: String -> String -> IO (Response String)+sendPOST url body = unResult $ simpleHTTP $ postRequestWithBody url "Text/Plain" body++unResult :: IO (Result (Response String)) -> IO (Response String)+unResult action = do+ res <- action+ case res of+ Right rsp -> return rsp+ Left _ -> error "Connection error"++readFileAscii :: FilePath -> IO String+readFileAscii name = do+ h <- openFile name ReadMode+ hSetEncoding h latin1+ hGetContents h
wai-app-file-cgi.cabal view
@@ -1,5 +1,5 @@ Name: wai-app-file-cgi-Version: 0.8.3+Version: 0.8.4 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -12,9 +12,16 @@ Cabal-Version: >= 1.10 Build-Type: Simple +Flag rev-proxy+ Description: Support reverse proxy wish http-conduit.+ This requires unnecessary crypt libraries.+ Default: True+ Library Default-Language: Haskell2010 GHC-Options: -Wall+ if flag(rev-proxy)+ Cpp-Options: -DREV_PROXY Exposed-Modules: Network.Wai.Application.Classic Other-Modules: Network.Wai.Application.Classic.CGI Network.Wai.Application.Classic.Conduit@@ -28,9 +35,11 @@ Network.Wai.Application.Classic.Path Network.Wai.Application.Classic.Range Network.Wai.Application.Classic.Redirect- Network.Wai.Application.Classic.RevProxy Network.Wai.Application.Classic.Status Network.Wai.Application.Classic.Types+ if flag(rev-proxy)+ Other-Modules: Network.Wai.Application.Classic.RevProxy+ Build-Depends: base >= 4 && < 5 , attoparsec >= 0.10.0.0 , attoparsec-conduit@@ -44,7 +53,6 @@ , directory , fast-logger >= 0.3 , filepath- , http-conduit >= 1.9 , http-date , http-types >= 0.7 , io-choice@@ -60,6 +68,8 @@ , wai >= 1.2 , wai-logger , word8+ if flag(rev-proxy)+ Build-Depends: http-conduit >= 1.9 Test-Suite doctest Type: exitcode-stdio-1.0@@ -83,12 +93,12 @@ , directory , filepath , hspec >= 1.3- , http-conduit , http-types , unix , wai , wai-app-file-cgi , warp+ , HTTP Source-Repository head Type: git