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 5c92e743bb012a1822847106947765cb5bfb7e5f (commit)
from 7378b0acf62722122e1542bdeeba5c983e591781 (commit)
Summary of changes:
README.SNAP.md | 4 +-
README.md | 4 +-
snap-server.cabal | 6 ++--
src/Snap/Internal/Http/Server.hs | 6 ++--
test/snap-server-testsuite.cabal | 4 +-
test/suite/Snap/Internal/Http/Server/Tests.hs | 39 +++++++++++++++++-------
6 files changed, 39 insertions(+), 24 deletions(-)
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 5c92e743bb012a1822847106947765cb5bfb7e5f
Author: Gregory Collins <[email protected]>
Date: Sun May 23 18:38:11 2010 -0400
Fix testsuite
diff --git a/README.SNAP.md b/README.SNAP.md
index 2cdcd08..96bea7b 100644
--- a/README.SNAP.md
+++ b/README.SNAP.md
@@ -1,5 +1,5 @@
-Snap Framework 0.1.1
---------------------
+Snap Framework
+--------------
This is the first developer prerelease of the Snap framework. Snap is a simple
and fast web development framework and server written in Haskell. For more
diff --git a/README.md b/README.md
index eba8cec..9d8cc52 100644
--- a/README.md
+++ b/README.md
@@ -1,5 +1,5 @@
-Snap Framework HTTP Server Library 0.1.1
-----------------------------------------
+Snap Framework HTTP Server Library
+----------------------------------
This is the first developer prerelease of the Snap Framework HTTP Server
library. For more information about Snap, read the `README.SNAP.md` or visit
diff --git a/snap-server.cabal b/snap-server.cabal
index e51ed47..1ee1896 100644
--- a/snap-server.cabal
+++ b/snap-server.cabal
@@ -1,5 +1,5 @@
name: snap-server
-version: 0.1.5
+version: 0.2.1
synopsis: A fast, iteratee-based, epoll-enabled web server for the Snap
Framework
description:
This is the first developer prerelease of the Snap framework. Snap is a
@@ -107,14 +107,14 @@ Library
network == 2.2.1.*,
old-locale,
sendfile >= 0.6.1 && < 0.7,
- snap-core >= 0.1.2 && <0.2,
+ snap-core >= 0.2.1 && <0.3,
time,
transformers,
unix,
vector >= 0.6 && <0.7
if flag(libev)
- build-depends: hlibev >= 0.2.1
+ build-depends: hlibev >= 0.2.2
other-modules: Snap.Internal.Http.Server.LibevBackend
cpp-options: -DLIBEV
else
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index 678d355..fa8e584 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -52,8 +52,8 @@ import Snap.Internal.Http.Server.Date
--
-- Note that we won't be bothering end users with this -- the details will be
-- hidden inside the Snap monad
-type ServerHandler = Request
- -> (ByteString -> IO ())
+type ServerHandler = (ByteString -> IO ())
+ -> Request
-> Iteratee IO (Request,Response)
type ServerMonad = StateT ServerState (Iteratee IO)
@@ -288,7 +288,7 @@ httpSession writeEnd onSendFile handler = do
case mreq of
(Just req) -> do
logerr <- gets _logError
- (req',rspOrig) <- lift $ handler req logerr
+ (req',rspOrig) <- lift $ handler logerr req
let rspTmp = rspOrig { rspHttpVersion = rqVersion req }
checkConnectionClose (rspHttpVersion rspTmp) (rspHeaders rspTmp)
diff --git a/test/snap-server-testsuite.cabal b/test/snap-server-testsuite.cabal
index 658378a..c21fc49 100644
--- a/test/snap-server-testsuite.cabal
+++ b/test/snap-server-testsuite.cabal
@@ -37,7 +37,7 @@ Executable testsuite
old-locale,
parallel > 2,
iteratee >= 0.3.1 && < 0.4,
- snap-core == 0.1.1,
+ snap-core >= 0.2.1 && <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,
@@ -87,7 +87,7 @@ Executable pongserver
network == 2.2.1.*,
network-bytestring >= 0.1.2 && < 0.2,
sendfile >= 0.6.1 && < 0.7,
- snap-core == 0.1.1,
+ snap-core >= 0.2.1 && <0.3,
time,
transformers,
unix,
diff --git a/test/suite/Snap/Internal/Http/Server/Tests.hs
b/test/suite/Snap/Internal/Http/Server/Tests.hs
index e89543e..22ccceb 100644
--- a/test/suite/Snap/Internal/Http/Server/Tests.hs
+++ b/test/suite/Snap/Internal/Http/Server/Tests.hs
@@ -323,8 +323,10 @@ testHttpResponse1 = testCase "HttpResponse1" $ do
-echoServer :: Request -> Iteratee IO (Request,Response)
-echoServer req = do
+echoServer :: (ByteString -> IO ())
+ -> Request
+ -> Iteratee IO (Request,Response)
+echoServer _ req = do
se <- liftIO $ readIORef (rqBody req)
let (SomeEnumerator enum) = se
let i = joinIM $ enum stream2stream
@@ -337,9 +339,9 @@ echoServer req = do
, rspContentLength = Just $ fromIntegral cl }
-echoServer2 :: Request -> Iteratee IO (Request,Response)
-echoServer2 req = do
- (rq,rsp) <- echoServer req
+echoServer2 :: ServerHandler
+echoServer2 _ req = do
+ (rq,rsp) <- echoServer (const $ return ()) req
return (rq, addCookie cook rsp)
where
cook = Cookie "foo" "bar" (Just utc) (Just ".foo.com") (Just "/")
@@ -412,8 +414,8 @@ testChunkOn1_0 = testCase "transfer-encoding chunked" $ do
where
lower = S.map (c2w . toLower . w2c) . S.concat . L.toChunks
- f :: Request -> Iteratee IO (Request, Response)
- f req = do
+ f :: ServerHandler
+ f _ req = do
let s = L.fromChunks $ Prelude.take 500 $ repeat "fldkjlfksdjlfd"
let out = enumLBS s
return (req, emptyResponse { rspBody = Enum out })
@@ -439,8 +441,17 @@ testHttp2 = testCase "connection: close" $ do
let (iter,onSendFile) = mkIter ref
- runHTTP "localhost" "127.0.0.1" 80 "127.0.0.1" 58384
- Nothing Nothing enumBody iter onSendFile echoServer2
+ runHTTP "localhost"
+ "127.0.0.1"
+ 80
+ "127.0.0.1"
+ 58384
+ Nothing
+ Nothing
+ enumBody
+ iter
+ onSendFile
+ echoServer2
s <- readIORef ref
@@ -494,9 +505,13 @@ testSendFile = testCase "sendFile" $ do
testServerStartupShutdown :: Test
testServerStartupShutdown = testCase "startup/shutdown" $ do
- tid <- forkIO $ httpServe "*" port "localhost"
- (Just "test-access.log") (Just "test-error.log") $
- runSnap pongServer
+ tid <- forkIO $
+ httpServe "*"
+ port
+ "localhost"
+ (Just "test-access.log")
+ (Just "test-error.log")
+ (runSnap pongServer)
waitabit
rsp <- HTTP.simpleHTTP (HTTP.getRequest "http://localhost:8145/")
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap