@@ -7,17 +7,20 @@ module Network.Wai.HTTP2
77 , Responder
88 , Trailers
99 , promiseHeaders
10− , writeBuilder
11− , writeFilePart
10+ , promoteApplication
11+ , responder
12+ , streamFilePart
13+ , streamBuilder
14+ , streamSimple
1215 ) where
1316
1417import Data.ByteString (ByteString)
15−import qualified Data.ByteString.Lazy as L
1618
1719import Data.ByteString.Builder (Builder)
1820import qualified Network.HTTP.Types as H
1921
20−import Network.Wai.Internal (FilePart, Request)
22+import Network.Wai (Application)
23+import Network.Wai.Internal (FilePart, Request, Response(..), ResponseReceived(..))
2124
2225-- | Headers sent after the end of a data stream, as defined by section 4.1.2 of
2326-- the HTTP\/1.1 spec (RFC 7230), and section 8.1 of the HTTP\/2 spec.
@@ -38,20 +41,14 @@ type HTTP2Application = Request -> PushFunc -> Responder
3841-- | Part of a streaming response -- either a 'Builder' or a range of a file.
3942data Chunk = FileChunk FilePath (Maybe FilePart) | BuilderChunk Builder
4043
41−-- | Given the write function of a stream body, write the given 'Builder'.
42−writeBuilder :: (Chunk -> IO ()) -> Builder -> IO ()
43−writeBuilder = (. BuilderChunk)
44−
45−-- | Given the write function of a stream body, write part or all of the given
46−-- file.
47−writeFilePart :: (Chunk -> IO ()) -> FilePath -> Maybe FilePart -> IO ()
48−writeFilePart = (.: FileChunk)
49− where f .: g = curry $ f . uncurry g
50−
5144-- | The streaming body of a response. Equivalent to
5245-- 'Network.Wai.StreamingBody' except that it can also write file ranges and
5346-- return a result of type @a@.
54−type Body a = (Chunk -> IO ()) -> IO () -> IO a
47+type Body a = BodyOf Chunk a
48+
49+-- | Generalization of 'Body' to arbitrary chunk types; this unifies with
50+-- 'Network.Wai.StreamingBody' with @c ~ Builder@ and @a ~ ()@.
51+type BodyOf c a = (c -> IO ()) -> IO () -> IO a
5552
5653-- | A function given to an 'HTTP2Application' used to send the response. This
5754-- is similar to the respond function in 'Network.Wai.Application', but the
@@ -77,3 +74,35 @@ promiseHeaders p =
7774 , (":authority", promisedAuthority p)
7875 , (":scheme", promisedScheme p)
7976 ] ++ promisedHeader p
77+
78+-- | Create a response body consisting of a single range of a file.
79+streamFilePart :: FilePath -> Maybe FilePart -> Body ()
80+streamFilePart path part write _ = write $ FileChunk path part
81+
82+-- | Create a response body consisting of a single builder.
83+streamBuilder :: Builder -> Body ()
84+streamBuilder builder write _ = write $ BuilderChunk builder
85+
86+-- | Equivalent to 'Body' but only streaming 'Builder's.
87+--
88+-- @'Network.Wai.StreamingBody' ~ SimpleBody ()@.
89+type SimpleBody a = BodyOf Builder a
90+
91+-- | Create a response body of a stream of 'Builder's.
92+streamSimple :: SimpleBody a -> Body a
93+streamSimple body write flush = body (write . BuilderChunk) flush
94+
95+-- | Use a normal WAI 'Response' to send the response. Useful if you're
96+-- sharing code between HTTP\/2 applications and HTTP\/1 applications.
97+responder :: Response -> Responder
98+responder response respond = case response of
99+ (ResponseFile s h path part) -> [] <$ respond s h (streamFilePart path part)
100+ (ResponseBuilder s h b) -> [] <$ respond s h (streamBuilder b)
101+ (ResponseStream s h body) -> [] <$ respond s h (streamSimple body)
102+ (ResponseRaw _ fallback) -> responder fallback respond
103+
104+-- | Promote a normal WAI 'Application' to an 'HTTP2Application' by ignoring
105+-- the HTTP/2-specific features.
106+promoteApplication :: Application -> HTTP2Application
107+promoteApplication app req _ respond = [] <$ app req respond'
108+ where respond' r = ResponseReceived <$ responder r respond