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, enumerator has been updated
via d7e7d6de01aaf1ad67e06433b67301d58535a991 (commit)
via 01fa6a78a121eba44303e4afb04f08699243b75f (commit)
from ffb7f661a99e5b490e8f53697cb3ebe021aa6121 (commit)
Summary of changes:
src/Snap/Internal/Http/Server.hs | 13 +++++++++----
test/suite/Test/Blackbox.hs | 20 ++++++++++++--------
2 files changed, 21 insertions(+), 12 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 d7e7d6de01aaf1ad67e06433b67301d58535a991
Merge: 01fa6a7 ffb7f66
Author: Gregory Collins <[email protected]>
Date: Sat Dec 4 12:39:08 2010 +0100
Merge branch 'enumerator' of git.snapframework.com:snap-server into
enumerator
commit 01fa6a78a121eba44303e4afb04f08699243b75f
Author: Gregory Collins <[email protected]>
Date: Sat Dec 4 12:38:28 2010 +0100
Fix a couple of enumerator bugs
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index 176a966..81db8fd 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -421,7 +421,7 @@ receiveRequest = do
let e = joinI . readChunkedTransferEncoding
liftIO $ writeIORef (rqBody req)
(SomeEnumerator e)
- else maybe noContentLength hasContentLength mbCL
+ else maybe (noContentLength req) hasContentLength mbCL
where
isChunked = maybe False
@@ -444,11 +444,16 @@ receiveRequest = do
joinI $ takeExactly len st'
- noContentLength :: ServerMonad ()
- noContentLength = liftIO $ do
+ noContentLength :: Request -> ServerMonad ()
+ noContentLength req = liftIO $ do
debug ("receiveRequest/setEnumerator: " ++
"request did NOT have content-length")
- writeIORef (rqBody req) (SomeEnumerator returnI)
+ let enum = SomeEnumerator $
+ if rqMethod req == POST || rqMethod req == PUT
+ then returnI
+ else iterateeDebugWrapper "noContentLength" .
+ joinI . I.take 0
+ writeIORef (rqBody req) enum
debug "receiveRequest/setEnumerator: body enumerator set"
diff --git a/test/suite/Test/Blackbox.hs b/test/suite/Test/Blackbox.hs
index 43eab3f..5d7d8bd 100644
--- a/test/suite/Test/Blackbox.hs
+++ b/test/suite/Test/Blackbox.hs
@@ -68,16 +68,18 @@ startTestServer :: Int
-> ConfigBackend
-> IO (ThreadId, MVar ())
startTestServer port sslport backend = do
- let cfg = setAccessLog (Just $ "ts-access.log." ++ show backend) .
- setErrorLog (Just $ "ts-error.log." ++ show backend) .
- addListen (ListenHttp "*" port) .
- setBackend backend .
- setVerbose False $
+ let cfg = setAccessLog (Just $ "ts-access." ++ show backend ++ ".log") .
+ setErrorLog (Just $ "ts-error." ++ show backend ++ ".log") .
+ addListen (ListenHttp "*" port) .
+ setBackend backend .
+ setVerbose False $
defaultConfig
let cfg' = case sslport of
Nothing -> cfg
- Just (p,_) -> addListen (ListenHttps "*" p "cert.pem"
"key.pem") cfg
+ Just (p,_) -> addListen
+ (ListenHttps "*" p "cert.pem" "key.pem")
+ cfg
mvar <- newEmptyMVar
tid <- forkIO $
@@ -162,7 +164,8 @@ testEcho port name = testProperty (name ++
"/blackbox/echo") $
let req' = (HTTP.mkRequest HTTP.POST uri) :: HTTP.Request S.ByteString
let req = HTTP.replaceHeader HTTP.HdrContentLength (show len) req'
- rsp <- QC.run $ HTTP.simpleHTTP $ req { HTTP.rqBody =
(txt::S.ByteString) }
+ rsp <- QC.run $ HTTP.simpleHTTP
+ $ req { HTTP.rqBody = (txt::S.ByteString) }
doc <- QC.run $ HTTP.getResponseBody rsp
QC.assert $ txt == doc
@@ -183,7 +186,8 @@ testRot13 port name = testProperty (name ++
"/blackbox/rot13") $
let req' = (HTTP.mkRequest HTTP.POST uri) :: HTTP.Request S.ByteString
let req = HTTP.replaceHeader HTTP.HdrContentLength (show len) req'
- rsp <- QC.run $ HTTP.simpleHTTP $ req { HTTP.rqBody =
(txt::S.ByteString) }
+ rsp <- QC.run $ HTTP.simpleHTTP
+ $ req { HTTP.rqBody = (txt::S.ByteString) }
doc <- QC.run $ HTTP.getResponseBody rsp
QC.assert $ txt == rot13 doc
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
