This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, master has been updated
via 49532df049a9b4b59627e26ba02f44b3f5bd9236 (commit)
from b482c98d0cda7dd03afee7f35b6ac5e77599a7bb (commit)
Summary of changes:
test/{pongserver => blackbox}/Paths_snap_server.hs | 0
test/blackbox/TestSuite.hs | 8 +++
test/snap-server-testsuite.cabal | 59 +++++++++++++++++++-
test/testserver/Main.hs | 24 ++++----
4 files changed, 79 insertions(+), 12 deletions(-)
copy test/{pongserver => blackbox}/Paths_snap_server.hs (100%)
create mode 100644 test/blackbox/TestSuite.hs
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 49532df049a9b4b59627e26ba02f44b3f5bd9236
Author: Gregory Collins <[email protected]>
Date: Mon Sep 6 22:18:49 2010 -0400
Add testsuite skeleton for blackbox testing
diff --git a/test/blackbox/Paths_snap_server.hs
b/test/blackbox/Paths_snap_server.hs
new file mode 100644
index 0000000..dc7b284
--- /dev/null
+++ b/test/blackbox/Paths_snap_server.hs
@@ -0,0 +1,9 @@
+module Paths_snap_server (
+ version
+ ) where
+
+import Data.Version (Version(..))
+
+version :: Version
+version = Version {versionBranch = [0,0,0], versionTags = ["unknown"]}
+
diff --git a/test/blackbox/TestSuite.hs b/test/blackbox/TestSuite.hs
new file mode 100644
index 0000000..9c1b3e9
--- /dev/null
+++ b/test/blackbox/TestSuite.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import Test.Framework (defaultMain, testGroup)
+
+
+main :: IO ()
+main = defaultMain tests
+ where tests = [ ]
diff --git a/test/snap-server-testsuite.cabal b/test/snap-server-testsuite.cabal
index 4b70052..2637fd5 100644
--- a/test/snap-server-testsuite.cabal
+++ b/test/snap-server-testsuite.cabal
@@ -68,6 +68,63 @@ Executable testsuite
-fno-warn-unused-do-bind
+Executable blackbox
+ hs-source-dirs: blackbox ../src
+ main-is: TestSuite.hs
+
+ build-depends:
+ QuickCheck >= 2,
+ array >= 0.3 && <0.4,
+ attoparsec >= 0.8.1 && < 0.9,
+ attoparsec-iteratee >= 0.1.1 && <0.2,
+ base >= 4 && < 5,
+ binary >= 0.5 && < 0.6,
+ bytestring,
+ bytestring-nums >= 0.3.1 && < 0.4,
+ bytestring-show >= 0.3.2 && < 0.4,
+ containers,
+ directory-tree,
+ dlist >= 0.5 && < 0.6,
+ filepath,
+ haskell98,
+ HTTP >= 4000.0.9 && < 4001,
+ HUnit >= 1.2 && < 2,
+ monads-fd,
+ murmur-hash >= 0.1 && < 0.2,
+ network == 2.2.1.7,
+ network-bytestring >= 0.1.2 && < 0.2,
+ old-locale,
+ parallel > 2,
+ iteratee >= 0.3.1 && < 0.4,
+ snap-core >= 0.2.12 && <0.3,
+ test-framework >= 0.3.1 && <0.4,
+ test-framework-hunit >= 0.2.5 && < 0.3,
+ test-framework-quickcheck2 >= 0.2.6 && < 0.3,
+ time,
+ transformers,
+ vector >= 0.6.0.1 && < 0.7
+
+ if !os(windows)
+ build-depends: unix
+
+ if flag(libev)
+ build-depends: hlibev >= 0.2.5 && < 0.3
+ other-modules: Snap.Internal.Http.Server.LibevBackend
+ cpp-options: -DLIBEV
+ else
+ build-depends: network-bytestring >= 0.1.2 && < 0.2,
+ PSQueue >= 1.1 && <1.2
+
+ other-modules: Snap.Internal.Http.Server.SimpleBackend
+
+ if flag(portable) || os(windows)
+ cpp-options: -DPORTABLE
+
+ ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded
+ -fno-warn-unused-do-bind
+
+
+
Executable pongserver
hs-source-dirs: pongserver ../src
main-is: Main.hs
@@ -213,7 +270,7 @@ Executable testserver
cpp-options: -DPORTABLE
ghc-options: -Wall -O2 -fwarn-tabs -funbox-strict-fields -threaded
- -fno-warn-unused-do-bind
+ -fno-warn-unused-do-bind -fhpc
ghc-prof-options: -prof -auto-all
diff --git a/test/testserver/Main.hs b/test/testserver/Main.hs
index 6a2d40c..a0592f4 100644
--- a/test/testserver/Main.hs
+++ b/test/testserver/Main.hs
@@ -1,9 +1,14 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Main where
import Control.Concurrent
+import Control.Monad
+
+import qualified Data.ByteString.Char8 as B
+import Data.Maybe
import Snap.Iteratee hiding (Enumerator)
import Snap.Types
@@ -25,13 +30,13 @@ slowloris attack / timeout test
pongHandler :: Snap ()
pongHandler = modifyResponse $ setResponseBody (enumBS "PONG") .
- setContentType "text/plain" .
- setContentLength 4
+ setContentType "text/plain" .
+ setContentLength 4
echoUriHandler :: Snap ()
echoUriHandler = do
req <- getRequest
- writeBS $ rqPathInfo req
+ writeBS $ rqURI req
echoHandler :: Snap ()
@@ -42,14 +47,11 @@ echoHandler = do
modifyResponse $ setResponseBody e'
+responseHandler :: Snap ()
responseHandler = do
- code <- getParam "code"
- case code of
- Nothing -> undefined
- Just code -> f code
- where
- f "300" = undefined
- f "304" = undefined
+ !code <- liftM (read . B.unpack . fromMaybe "503") $ getParam "code"
+ modifyResponse $ setResponseCode code
+ writeBS $ B.pack $ show code
handlers :: Snap ()
@@ -57,7 +59,7 @@ handlers =
route [ ("pong", pongHandler)
, ("echo", echoHandler)
, ("echoUri", echoUriHandler)
- , ("fileserve", fileServe "static")
+ , ("fileserve", fileServe "testserver/static")
, ("respcode/:code", responseHandler)
]
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
