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 ef7def97a0f419372f8dda30376108bf24a57b56 (commit)
from fead1586fdd5485041c549caeccca67822c4530a (commit)
Summary of changes:
test/{pongserver => common}/Paths_snap_server.hs | 0
.../Main.hs => common/Test/Common/TestHandler.hs} | 37 ++----------
test/snap-server-testsuite.cabal | 64 +++++++++++++++++++-
test/suite/Paths_snap_server.hs | 9 ---
test/testserver/Main.hs | 47 +--------------
test/testserver/Paths_snap_server.hs | 9 ---
6 files changed, 68 insertions(+), 98 deletions(-)
rename test/{pongserver => common}/Paths_snap_server.hs (100%)
copy test/{testserver/Main.hs => common/Test/Common/TestHandler.hs} (72%)
delete mode 100644 test/suite/Paths_snap_server.hs
delete mode 100644 test/testserver/Paths_snap_server.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 ef7def97a0f419372f8dda30376108bf24a57b56
Author: Gregory Collins <[email protected]>
Date: Thu Sep 9 14:42:45 2010 -0400
Reorg testsuite a little -- put testserver back in, move code to a 'common'
area
diff --git a/test/pongserver/Paths_snap_server.hs
b/test/common/Paths_snap_server.hs
similarity index 100%
rename from test/pongserver/Paths_snap_server.hs
rename to test/common/Paths_snap_server.hs
diff --git a/test/testserver/Main.hs b/test/common/Test/Common/TestHandler.hs
similarity index 72%
copy from test/testserver/Main.hs
copy to test/common/Test/Common/TestHandler.hs
index a0592f4..8e7bade 100644
--- a/test/testserver/Main.hs
+++ b/test/common/Test/Common/TestHandler.hs
@@ -1,10 +1,9 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-module Main where
+module Test.Common.TestHandler (testHandler) where
+
-import Control.Concurrent
import Control.Monad
import qualified Data.ByteString.Char8 as B
@@ -15,18 +14,8 @@ import Snap.Types
import Snap.Http.Server
import Snap.Util.FileServe
+import Snap.Internal.Iteratee.Debug
-import Snap.Internal.Iteratee.Debug
-
-{-
-
-/pong
-/fileserve
-/echo
-pipelined POST requests
-slowloris attack / timeout test
-
--}
pongHandler :: Snap ()
pongHandler = modifyResponse $ setResponseBody (enumBS "PONG") .
@@ -54,8 +43,8 @@ responseHandler = do
writeBS $ B.pack $ show code
-handlers :: Snap ()
-handlers =
+testHandler :: Snap ()
+testHandler =
route [ ("pong", pongHandler)
, ("echo", echoHandler)
, ("echoUri", echoUriHandler)
@@ -63,19 +52,3 @@ handlers =
, ("respcode/:code", responseHandler)
]
-
-main :: IO ()
-main = do
- m <- newEmptyMVar
-
- forkIO $ go m
- takeMVar m
-
- return ()
-
- where
- go m = do
- httpServe "*" 3000 "localhost" (Just "ts-access.log")
- (Just "ts-error.log") handlers
- putMVar m ()
-
diff --git a/test/snap-server-testsuite.cabal b/test/snap-server-testsuite.cabal
index fbe9b57..2af0a6c 100644
--- a/test/snap-server-testsuite.cabal
+++ b/test/snap-server-testsuite.cabal
@@ -13,7 +13,7 @@ Flag portable
Default: False
Executable testsuite
- hs-source-dirs: suite ../src
+ hs-source-dirs: suite common ../src
main-is: TestSuite.hs
build-depends:
@@ -71,7 +71,7 @@ Executable testsuite
Executable pongserver
- hs-source-dirs: pongserver ../src
+ hs-source-dirs: pongserver common ../src
main-is: Main.hs
build-depends:
@@ -145,8 +145,66 @@ Executable pongserver
ghc-prof-options: -prof -auto-all
+Executable testserver
+ hs-source-dirs: testserver common ../src
+ main-is: Main.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,
+ template-haskell,
+ 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 -fwarn-tabs
+ -funbox-strict-fields -threaded
+ -fno-warn-unused-do-bind
+
+
Executable benchmark
- hs-source-dirs: benchmark ../src
+ hs-source-dirs: benchmark common ../src
main-is: Benchmark.hs
build-depends:
base >= 4 && < 5,
diff --git a/test/suite/Paths_snap_server.hs b/test/suite/Paths_snap_server.hs
deleted file mode 100644
index dc7b284..0000000
--- a/test/suite/Paths_snap_server.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Paths_snap_server (
- version
- ) where
-
-import Data.Version (Version(..))
-
-version :: Version
-version = Version {versionBranch = [0,0,0], versionTags = ["unknown"]}
-
diff --git a/test/testserver/Main.hs b/test/testserver/Main.hs
index a0592f4..e4e3956 100644
--- a/test/testserver/Main.hs
+++ b/test/testserver/Main.hs
@@ -5,18 +5,10 @@
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
import Snap.Http.Server
-import Snap.Util.FileServe
-
+import Test.Common.TestHandler
-import Snap.Internal.Iteratee.Debug
{-
@@ -28,41 +20,6 @@ slowloris attack / timeout test
-}
-pongHandler :: Snap ()
-pongHandler = modifyResponse $ setResponseBody (enumBS "PONG") .
- setContentType "text/plain" .
- setContentLength 4
-
-echoUriHandler :: Snap ()
-echoUriHandler = do
- req <- getRequest
- writeBS $ rqURI req
-
-
-echoHandler :: Snap ()
-echoHandler = do
- unsafeDetachRequestBody >>= \e -> do
- let (SomeEnumerator x) = e
- let e' i = x (iterateeDebugWrapper "echoHandler" i)
- modifyResponse $ setResponseBody e'
-
-
-responseHandler :: Snap ()
-responseHandler = do
- !code <- liftM (read . B.unpack . fromMaybe "503") $ getParam "code"
- modifyResponse $ setResponseCode code
- writeBS $ B.pack $ show code
-
-
-handlers :: Snap ()
-handlers =
- route [ ("pong", pongHandler)
- , ("echo", echoHandler)
- , ("echoUri", echoUriHandler)
- , ("fileserve", fileServe "testserver/static")
- , ("respcode/:code", responseHandler)
- ]
-
main :: IO ()
main = do
@@ -76,6 +33,6 @@ main = do
where
go m = do
httpServe "*" 3000 "localhost" (Just "ts-access.log")
- (Just "ts-error.log") handlers
+ (Just "ts-error.log") testHandler
putMVar m ()
diff --git a/test/testserver/Paths_snap_server.hs
b/test/testserver/Paths_snap_server.hs
deleted file mode 100644
index dc7b284..0000000
--- a/test/testserver/Paths_snap_server.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Paths_snap_server (
- version
- ) where
-
-import Data.Version (Version(..))
-
-version :: Version
-version = Version {versionBranch = [0,0,0], versionTags = ["unknown"]}
-
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
