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-core".
The branch, master has been updated
via 20c272b8be99a20838d184cfe6f4774b240fdab3 (commit)
from 9c111a02521c4985b7a13d8a36c32f4b9424a939 (commit)
Summary of changes:
src/Snap/Internal/Http/Types.hs | 17 +++++++++--------
src/Snap/Internal/Types.hs | 39 ++++++++++++++++++++++-----------------
src/Snap/Types.hs | 5 +++--
test/suite/Snap/Types/Tests.hs | 16 ++++------------
4 files changed, 38 insertions(+), 39 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 20c272b8be99a20838d184cfe6f4774b240fdab3
Author: Gregory Collins <[email protected]>
Date: Fri Sep 10 15:38:30 2010 -0400
Remove unsafeDetachRequestBody in favour of new transformRequestBody
function
diff --git a/src/Snap/Internal/Http/Types.hs b/src/Snap/Internal/Http/Types.hs
index ad8a22a..98168f4 100644
--- a/src/Snap/Internal/Http/Types.hs
+++ b/src/Snap/Internal/Http/Types.hs
@@ -365,23 +365,24 @@ rspBodyToEnum (SendFile fp) = I.enumFile fp
------------------------------------------------------------------------------
-- | Represents an HTTP response.
data Response = Response
- { rspHeaders :: Headers
- , rspHttpVersion :: !HttpVersion
+ { rspHeaders :: Headers
+ , rspHttpVersion :: !HttpVersion
-- | We will need to inspect the content length no matter what, and
-- looking up \"content-length\" in the headers and parsing the number
-- out of the text will be too expensive.
- , rspContentLength :: !(Maybe Int64)
- , rspBody :: ResponseBody
+ , rspContentLength :: !(Maybe Int64)
+ , rspBody :: ResponseBody
-- | Returns the HTTP status code.
- , rspStatus :: !Int
+ , rspStatus :: !Int
-- | Returns the HTTP status explanation string.
- , rspStatusReason :: !ByteString
+ , rspStatusReason :: !ByteString
- -- | If true, we detached the request body with 'unsafeDetachRequestBody'
- , rspDetachedBody :: !Bool
+ -- | If true, we are transforming the request body with
+ -- 'transformRequestBody'
+ , rspTransformingRqBody :: !Bool
}
diff --git a/src/Snap/Internal/Types.hs b/src/Snap/Internal/Types.hs
index 6e11b22..37429c0 100644
--- a/src/Snap/Internal/Types.hs
+++ b/src/Snap/Internal/Types.hs
@@ -201,19 +201,22 @@ getRequestBody = liftM fromWrap $ runRequestBody
stream2stream
------------------------------------------------------------------------------
--- | Detaches the request body's 'Enumerator' from the 'Request' and
--- returns it. You would want to use this if you needed to send the
--- HTTP request body (transformed or otherwise) through to the output
--- in O(1) space. (Examples: transcoding, \"echo\", etc)
+-- | Normally Snap is careful to ensure that the request body is fully consumed
+-- after your web handler runs, but before the 'Response' enumerator is
+-- streamed out the socket. If you want to transform the request body into some
+-- output in O(1) space, you should use this function.
--
--- Normally Snap is careful to ensure that the request body is fully
--- consumed after your web handler runs; this function is marked
--- \"unsafe\" because it breaks this guarantee and leaves the
--- responsibility up to you. If you don't fully consume the
--- 'Enumerator' you get here, the next HTTP request in the pipeline
--- (if any) will misparse. Be careful with exception handlers.
-unsafeDetachRequestBody :: Snap SomeEnumerator
-unsafeDetachRequestBody = do
+-- Note that upon calling this function, response processing finishes early as
+-- if you called 'finishWith'. Make sure you set any content types, headers,
+-- cookies, etc. before you call this function.
+--
+transformRequestBody :: (forall a . Enumerator a)
+ -- ^ the output 'Iteratee' is passed to this
+ -- 'Enumerator', and then the resulting 'Iteratee' is
+ -- fed the request body stream. Your 'Enumerator' is
+ -- responsible for transforming the input.
+ -> Snap ()
+transformRequestBody trans = do
req <- getRequest
let ioref = rqBody req
senum <- liftIO $ readIORef ioref
@@ -221,11 +224,13 @@ unsafeDetachRequestBody = do
liftIO $ writeIORef ioref
(SomeEnumerator $ return . Iter.joinI . Iter.take 0)
- modifyResponse $ \rsp -> rsp { rspDetachedBody = True }
-
- return $ SomeEnumerator
- $ \i -> enum $
- iterateeDebugWrapper "unsafeDetachRequestBody" i
+ origRsp <- getResponse
+ let rsp = setResponseBody
+ (\writeEnd -> do
+ i <- trans writeEnd
+ enum $ iterateeDebugWrapper "transformRequestBody" i)
+ $ origRsp { rspTransformingRqBody = True }
+ finishWith rsp
------------------------------------------------------------------------------
diff --git a/src/Snap/Types.hs b/src/Snap/Types.hs
index 46e9101..1a47f9e 100644
--- a/src/Snap/Types.hs
+++ b/src/Snap/Types.hs
@@ -37,10 +37,11 @@ module Snap.Types
-- ** Logging
, logError
- -- ** Grabbing request bodies
+ -- ** Grabbing/transforming request bodies
, runRequestBody
, getRequestBody
- , unsafeDetachRequestBody
+ , transformRequestBody
+
-- * HTTP Datatypes and Functions
-- $httpDoc
--
diff --git a/test/suite/Snap/Types/Tests.hs b/test/suite/Snap/Types/Tests.hs
index c92b5cd..8cdcd6a 100644
--- a/test/suite/Snap/Types/Tests.hs
+++ b/test/suite/Snap/Types/Tests.hs
@@ -219,13 +219,10 @@ testRqBody = testCase "request bodies" $ do
assertEqual "rq body" "zazzle" v1
assertEqual "rq body 2" "" v2
- _ <- goBody $ g mvar1 mvar2
- w1 <- takeMVar mvar1
- w2 <- takeMVar mvar2
-
- assertEqual "rq body" "zazzle" w1
- assertEqual "rq body 2" "" w2
+ (_,rsp) <- goBody g
+ bd <- getBody rsp
+ assertEqual "detached rq body" "zazzle" bd
where
@@ -233,12 +230,7 @@ testRqBody = testCase "request bodies" $ do
getRequestBody >>= liftIO . putMVar mvar1
getRequestBody >>= liftIO . putMVar mvar2
- g mvar1 mvar2 = do
- senum <- unsafeDetachRequestBody
- let (SomeEnumerator enum) = senum
- bs <- liftM fromWrap (liftIO $ enum stream2stream >>= run)
- liftIO $ putMVar mvar1 bs
- getRequestBody >>= liftIO . putMVar mvar2
+ g = transformRequestBody return
testTrivials :: Test
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
