@@ -1,5 +1,6 @@
11{-# LANGUAGE Rank2Types #-}
22{-# LANGUAGE CPP #-}
3+{-# LANGUAGE ImpredicativeTypes #-}
34{-|
45
56This module defines a generic web application interface. It is a common
@@ -61,13 +62,13 @@ module Network.Wai
6162 , lazyRequestBody
6263 -- * Response
6364 , Response
65+ , StreamingBody
6466 , FilePart (..)
6567 -- ** Response composers
6668 , responseFile
6769 , responseBuilder
6870 , responseLBS
6971 , responseStream
70− , responseStreamBracket
7172 , responseRaw
7273 -- * Response accessors
7374 , responseStatus
@@ -78,9 +79,12 @@ module Network.Wai
7879import Blaze.ByteString.Builder (Builder, fromLazyByteString)
7980import Blaze.ByteString.Builder (fromByteString)
8081import Control.Exception (bracket, bracketOnError)
82+import Control.Monad (unless)
8183import qualified Data.ByteString as B
8284import qualified Data.ByteString.Lazy as L
85+import Data.ByteString.Lazy.Internal (defaultChunkSize)
8386import Data.ByteString.Lazy.Char8 ()
87+import Data.Function (fix)
8488import Data.Monoid (mempty)
8589import qualified Network.HTTP.Types as H
8690import Network.Socket (SockAddr (SockAddrInet))
@@ -125,30 +129,12 @@ responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response
125129responseLBS s h = ResponseBuilder s h . fromLazyByteString
126130
127131-- | Creating 'Response' from 'C.Source'.
128−responseStream :: H.Status -> H.ResponseHeaders -> ((Maybe Builder -> IO ()) -> IO ()) -> Response
132+responseStream :: H.Status
133+ -> H.ResponseHeaders
134+ -> StreamingBody
135+ -> Response
129136responseStream = ResponseStream
130137
131−-- | Creating 'Response' with allocated resource safely released.
132−--
133−-- * The first argument is an action to allocate resource.
134−--
135−-- * The second argument is a function to release the resource.
136−--
137−-- * The third argument is a function to create
138−-- ('H.Status','H.ResponseHeaders','C.Source' 'IO' ('C.Flush' 'Builder'))
139−-- from the resource.
140−responseStreamBracket :: IO a
141− -> (a -> IO ())
142− -> (a -> IO (H.Status
143− ,H.ResponseHeaders
144− ,(Maybe Builder -> IO ()) -> IO ()))
145− -> IO Response
146−responseStreamBracket setup teardown action =
147− bracketOnError setup teardown $ \resource -> do
148− (st,hdr,stream) <- action resource
149− return $ ResponseStream st hdr $ \f ->
150− bracket (return resource) teardown (\_ -> stream f)
151−
152138-- | Create a response for a raw application. This is useful for \"upgrade\"
153139-- situations such as WebSockets, where an application requests for the server
154140-- to grant it raw network access.
@@ -183,16 +169,26 @@ responseHeaders (ResponseRaw _ res) = responseHeaders res
183169
184170-- | Converting the body information in 'Response' to 'Source'.
185171responseToStream :: Response
186− -> (H.Status, H.ResponseHeaders, (Maybe Builder -> IO ()) -> IO ())
187−responseToStream (ResponseStream s h b) = (s, h, b)
172+ -> ( H.Status
173+ , H.ResponseHeaders
174+ , forall a. (StreamingBody -> IO a) -> IO a
175+ )
176+responseToStream (ResponseStream s h b) = (s, h, ($ b))
188177responseToStream (ResponseFile s h fp (Just part)) =
189178 error "FIXME responseToStream"
190179 --(s, h, \f -> IO.withFile fp IO.ReadMode $ \handle -> f $ sourceFilePart handle part C.$= CL.map (C.Chunk . fromByteString))
191180responseToStream (ResponseFile s h fp Nothing) =
192− error "FIXME responseToStream"
193− --(s, h, \f -> IO.withFile fp IO.ReadMode $ \handle -> f $ CB.sourceHandle handle C.$= CL.map (C.Chunk . fromByteString))
181+ ( s
182+ , h
183+ , \withBody -> IO.withFile fp IO.ReadMode $ \handle ->
184+ withBody $ \sendChunk _flush -> fix $ \loop -> do
185+ bs <- B.hGetSome handle defaultChunkSize
186+ unless (B.null bs) $ do
187+ sendChunk $ fromByteString bs
188+ loop
189+ )
194190responseToStream (ResponseBuilder s h b) =
195− (s, h, ($ Just b))
191+ (s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b)
196192responseToStream (ResponseRaw _ res) = responseToStream res
197193
198194{- FIXME