wai-app-file-cgi 0.8.0 → 0.8.1
raw patch · 8 files changed
+263/−192 lines, 8 filesdep +doctestdep +hspecdep +wai-app-file-cgidep −HUnitdep −test-framework-doctestdep −test-framework-hunitdep ~basedep ~conduitdep ~wai
Dependencies added: doctest, hspec, wai-app-file-cgi, warp, word8
Dependencies removed: HUnit, test-framework-doctest, test-framework-hunit, test-framework-th-prime
Dependency ranges changed: base, conduit, wai
Files
- Network/Wai/Application/Classic.hs +4/−0
- Network/Wai/Application/Classic/Def.hs +69/−0
- Network/Wai/Application/Classic/Path.hs +1/−1
- test/ClassicSpec.hs +111/−0
- test/Spec.hs +41/−0
- test/Test.hs +0/−181
- test/doctests.hs +9/−0
- wai-app-file-cgi.cabal +28/−10
Network/Wai/Application/Classic.hs view
@@ -5,9 +5,11 @@ module Network.Wai.Application.Classic ( -- * Common ClassicAppSpec(..)+ , defaultClassicAppSpec , StatusInfo(..) -- * Files , FileAppSpec(..)+ , defaultFileAppSpec , FileInfo(..) , FileRoute(..) , fileApp@@ -16,6 +18,7 @@ , redirectApp -- * CGI , CgiAppSpec(..)+ , defaultCgiAppSpec , CgiRoute(..) , cgiApp -- * Reverse Proxy@@ -34,3 +37,4 @@ import Network.Wai.Application.Classic.Redirect import Network.Wai.Application.Classic.RevProxy import Network.Wai.Application.Classic.Types+import Network.Wai.Application.Classic.Def
+ Network/Wai/Application/Classic/Def.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Wai.Application.Classic.Def where++import Control.Applicative+import Control.Exception+import Network.HTTP.Date+import Network.Wai.Application.Classic.Path+import Network.Wai.Application.Classic.Types+import Network.Wai.Logger+import System.Log.FastLogger.Date+import System.Posix++-- |+-- Default value for 'ClassicAppSpec'. 'softwareName' is \"Classic\". 'logger' does not log at all. 'dater' calls 'epochTime' for every request. 'statusFileDir' is \"\/usr\/local\/share\/html\/status\/\".+defaultClassicAppSpec :: ClassicAppSpec+defaultClassicAppSpec = ClassicAppSpec {+ softwareName = "Classic"+ , logger = defaultLogger+ , dater = defaultDater+ , statusFileDir = "/usr/local/share/html/status/"+ }++defaultLogger :: ApacheLogger+defaultLogger _ _ _ = return ()++defaultDater :: IO ZonedDate+defaultDater = formatHTTPDate . epochTimeToHTTPDate <$> epochTime++----------------------------------------------------------------++-- |+-- Default value for 'defaultFileAppSpec'. 'indexFile' is \"index.html\". 'isHTML' matches \"*.html\" and \"*.html\". 'getFileInfo' calls `getFileStatus` for every request.+defaultFileAppSpec :: FileAppSpec+defaultFileAppSpec = FileAppSpec {+ indexFile = "index.html"+ , isHTML = defaultIsHTml+ , getFileInfo = defaultGetFileInfo+ }++defaultIsHTml :: Path -> Bool+defaultIsHTml file = ".html" `isSuffixOf` file || ".htm" `isSuffixOf` file++defaultGetFileInfo :: Path -> IO FileInfo+defaultGetFileInfo path = do+ fs <- getFileStatus sfile+ if not (isDirectory fs) then+ return FileInfo {+ fileInfoName = path+ , fileInfoSize = size fs+ , fileInfoTime = time fs+ , fileInfoDate = formatHTTPDate (time fs)+ }+ else+ throwIO $ userError "does not exist"+ where+ sfile = pathString path+ size = fromIntegral . fileSize+ time = epochTimeToHTTPDate . modificationTime++----------------------------------------------------------------++-- |+-- Default value for 'defaultCgiAppSpec'. 'indexCgi' is \"index.cgi\".+defaultCgiAppSpec :: CgiAppSpec+defaultCgiAppSpec = CgiAppSpec {+ indexCgi = "index.cgi"+ }+
Network/Wai/Application/Classic/Path.hs view
@@ -154,7 +154,7 @@ {-| Breaking at the first path separator.- + >>> breakAtSeparator "/foo/bar/baz" ("","/foo/bar/baz") >>> breakAtSeparator "foo/bar/baz"
+ test/ClassicSpec.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}++module ClassicSpec where++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)+import Test.Hspec++spec :: Spec+spec = do+ describe "cgiApp" $ do+ it "accepts POST" $ do+ let url = "http://127.0.0.1:2345/cgi-bin/echo-env/pathinfo?query=foo"+ Response _ _ _ bdy <- sendPOST url "foo bar.\nbaz!\n"+ ans <- BL.readFile "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"+ Response sc _ _ _ <- sendPOST url "foo bar.\nbaz!\n"+ sc `shouldBe` H.internalServerError500++ 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+ it "returns 400 if not exist" $ do+ let url = "http://127.0.0.1:2345/dummy"+ req <- parseUrl url+ Response sc _ _ _ <- safeHttpLbs req+ sc `shouldBe` H.notFound404+ it "returns Japanese HTML if language is specified" $ do+ let url = "http://127.0.0.1:2345/ja/"+ Response _ _ _ bdy <- sendGET url [("Accept-Language", "ja, en;q=0.7")]+ ans <- BL.readFile "test/html/ja/index.html.ja"+ bdy `shouldBe` ans+ it "returns 304 if not changed" $ do+ let url = "http://127.0.0.1:2345/"+ Response _ _ hdr _ <- sendGET url []+ let Just lm = lookup "Last-Modified" hdr+ Response sc _ _ _ <- sendGET url [("If-Modified-Since", lm)]+ sc `shouldBe` H.notModified304+ it "can handle partial request" $ do+ let url = "http://127.0.0.1:2345/"+ ans = "html>\n<html"+ Response _ _ _ bdy <- sendGET url [("Range", "bytes=10-20")]+ bdy `shouldBe` ans+ it "can handle HEAD" $ do+ let url = "http://127.0.0.1:2345/"+ Response sc _ _ _ <- sendHEAD url []+ sc `shouldBe` H.ok200+ it "returns 404 for HEAD if not exist" $ do+ let url = "http://127.0.0.1:2345/dummy"+ Response sc _ _ _ <- sendHEAD url []+ sc `shouldBe` H.notFound404+ it "can handle HEAD even if language is specified" $ do+ let url = "http://127.0.0.1:2345/ja/"+ Response sc _ _ _ <- sendHEAD url [("Accept-Language", "ja, en;q=0.7")]+ sc `shouldBe` H.ok200+ it "returns 304 for HEAD if not modified" $ do+ let url = "http://127.0.0.1:2345/"+ Response _ _ hdr _ <- sendHEAD url []+ let Just lm = lookup "Last-Modified" hdr+ Response sc _ _ _ <- sendHEAD url [("If-Modified-Since", lm)]+ sc `shouldBe` H.notModified304+ 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+++----------------------------------------------------------------++sendGET ::String -> H.RequestHeaders -> IO (Response BL.ByteString)+sendGET url hdr = do+ req' <- parseUrl url+ let req = req' { requestHeaders = hdr }+ safeHttpLbs req++sendHEAD :: String -> H.RequestHeaders -> IO (Response BL.ByteString)+sendHEAD url hdr = do+ req' <- parseUrl url+ let req = req' {+ requestHeaders = hdr+ , method = "HEAD"+ }+ safeHttpLbs req++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++----------------------------------------------------------------++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 H.http11 hd BL.empty)+httpHandler _ = error "handler"
+ test/Spec.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import ClassicSpec+import Control.Concurrent+import Control.Monad+import qualified Data.ByteString as BS+import Network.Wai+import Network.Wai.Application.Classic hiding ((</>))+import Network.Wai.Handler.Warp+import System.Directory+import System.FilePath+import Test.Hspec++main :: IO ()+main = do+ void $ forkIO testServer+ threadDelay 100000+ hspec spec++testServer :: IO ()+testServer = do+ dir <- getCurrentDirectory+ run 2345 $ testApp dir++testApp :: FilePath -> Application+testApp dir req+ | cgi = cgiApp appSpec defaultCgiAppSpec cgiRoute req+ | otherwise = fileApp appSpec defaultFileAppSpec fileRoute req+ where+ cgi = "/cgi-bin/" `BS.isPrefixOf` rawPathInfo req+ appSpec = defaultClassicAppSpec { softwareName = "ClassicTester" }+ cgiRoute = CgiRoute {+ cgiSrc = "/cgi-bin/"+ , cgiDst = fromString (dir </> "test/cgi-bin/")+ }+ fileRoute = FileRoute {+ fileSrc = "/"+ , fileDst = fromString (dir </> "test/html/")+ }
− test/Test.hs
@@ -1,181 +0,0 @@-{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}--module Main where--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)-import Test.Framework.Providers.DocTest-import Test.Framework.Providers.HUnit-import Test.Framework.TH.Prime-import Test.HUnit--------------------------------------------------------------------main :: IO ()-main = $(defaultMainGenerator)--------------------------------------------------------------------doc_test :: DocTests-doc_test = docTest ["Network/Wai/Application/Classic.hs"] ["-XOverloadedStrings"]-------------------------------------------------------------------case_post :: Assertion-case_post = do- Response _ _ _ bdy <- sendPOST url "foo bar.\nbaz!\n"- ans <- BL.readFile "test/data/post"- bdy @?= ans- where- url = "http://localhost:8080/cgi-bin/echo-env/pathinfo?query=foo"--case_post2 :: Assertion-case_post2 = do- Response sc _ _ _ <- sendPOST url "foo bar.\nbaz!\n"- sc @?= H.internalServerError500- where- url = "http://localhost:8080/cgi-bin/broken"--------------------------------------------------------------------case_get :: Assertion-case_get = do- rsp <- simpleHttp url- ans <- BL.readFile "test/html/index.html"- rsp @?= ans- where- url = "http://localhost:8080/"--------------------------------------------------------------------case_get2 :: Assertion-case_get2 = do- req <- parseUrl url- Response sc _ _ _ <- safeHttpLbs req- sc @?= H.notFound404- where- url = "http://localhost:8080/dummy"--------------------------------------------------------------------case_get_ja :: Assertion-case_get_ja = do- Response _ _ _ bdy <- sendGET url [("Accept-Language", "ja, en;q=0.7")]- ans <- BL.readFile "test/html/ja/index.html.ja"- bdy @?= ans- where- url = "http://localhost:8080/ja/"--------------------------------------------------------------------case_get_modified :: Assertion-case_get_modified = do- Response _ _ hdr _ <- sendGET url []- let Just lm = lookup "Last-Modified" hdr- Response sc _ _ _ <- sendGET url [("If-Modified-Since", lm)]- sc @?= H.notModified304- where- url = "http://localhost:8080/"--------------------------------------------------------------------case_get_partial :: Assertion-case_get_partial = do- Response _ _ _ bdy <- sendGET url [("Range", "bytes=10-20")]- bdy @?= ans- where- url = "http://localhost:8080/"- ans = "html>\n<html"--------------------------------------------------------------------case_head :: Assertion-case_head = do- Response sc _ _ _ <- sendHEAD url []- sc @?= H.ok200- where- url = "http://localhost:8080/"--------------------------------------------------------------------case_head2 :: Assertion-case_head2 = do- Response sc _ _ _ <- sendHEAD url []- sc @?= H.notFound404- where- url = "http://localhost:8080/dummy"--------------------------------------------------------------------case_head_ja :: Assertion-case_head_ja = do- Response sc _ _ _ <- sendHEAD url [("Accept-Language", "ja, en;q=0.7")]- sc @?= H.ok200- where- url = "http://localhost:8080/ja/"--------------------------------------------------------------------case_head_modified :: Assertion-case_head_modified = do- Response _ _ hdr _ <- sendHEAD url []- let Just lm = lookup "Last-Modified" hdr- Response sc _ _ _ <- sendHEAD url [("If-Modified-Since", lm)]- sc @?= H.notModified304- where- url = "http://localhost:8080/"--------------------------------------------------------------------case_redirect :: Assertion-case_redirect = do- rsp <- simpleHttp url- ans <- BL.readFile "test/html/redirect/index.html"- rsp @?= ans- where- url = "http://localhost:8080/redirect"-------------------------------------------------------------------------------------------------------------------------------------sendGET ::String -> H.RequestHeaders -> IO (Response BL.ByteString)-sendGET url hdr = do- req' <- parseUrl url- let req = req' { requestHeaders = hdr }- safeHttpLbs req--------------------------------------------------------------------sendHEAD :: String -> H.RequestHeaders -> IO (Response BL.ByteString)-sendHEAD url hdr = do- req' <- parseUrl url- let req = req' {- requestHeaders = hdr- , method = "HEAD"- }- safeHttpLbs req--------------------------------------------------------------------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--------------------------------------------------------------------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 H.http11 hd BL.empty)-httpHandler _ = error "handler"
+ test/doctests.hs view
@@ -0,0 +1,9 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest [+ "-XOverloadedStrings"+ , "Network/Wai/Application/Classic.hs"+ ]
wai-app-file-cgi.cabal view
@@ -1,5 +1,5 @@ Name: wai-app-file-cgi-Version: 0.8.0+Version: 0.8.1 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -9,14 +9,16 @@ executes CGI scripts, and serves as a reverse proxy. Homepage: http://www.mew.org/~kazu/proj/mighttpd/ Category: Web, Yesod-Cabal-Version: >= 1.8+Cabal-Version: >= 1.10 Build-Type: Simple Library+ Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Network.Wai.Application.Classic Other-Modules: Network.Wai.Application.Classic.CGI Network.Wai.Application.Classic.Conduit+ Network.Wai.Application.Classic.Def Network.Wai.Application.Classic.EventSource Network.Wai.Application.Classic.Field Network.Wai.Application.Classic.File@@ -57,21 +59,37 @@ , unix , wai >= 1.2 , wai-logger+ , word8 -Test-Suite test- Main-Is: Test.hs+Test-Suite doctest Type: exitcode-stdio-1.0+ Default-Language: Haskell2010 HS-Source-Dirs: test- Build-Depends: base >= 4 && < 5+ Ghc-Options: -threaded -Wall+ Main-Is: doctests.hs+ Build-Depends: base+ , doctest >= 0.9.3++Test-Suite spec+ Type: exitcode-stdio-1.0+ Default-Language: Haskell2010+ HS-Source-Dirs: test+ Ghc-Options: -threaded -Wall+ Main-Is: Spec.hs+ Other-Modules: ClassicSpec+ Build-Depends: base , bytestring- , conduit >= 0.5 && < 0.6+ , conduit+ , directory+ , filepath+ , hspec >= 1.3 , http-conduit , http-types , lifted-base- , HUnit- , test-framework-doctest- , test-framework-hunit- , test-framework-th-prime+ , unix+ , wai+ , wai-app-file-cgi+ , warp Source-Repository head Type: git