Chunked responses

docs/Examples/Image/Main.purs → docs/Examples/Binary/Main.purs

@@ -1,4 +1,4 @@
-module Examples.Image.Main where
+module Examples.Binary.Main where
 
 import Prelude
 
@@ -16,7 +16,7 @@ portS = show port
 
 -- | The path to the file containing the response to send
 filePath :: String
-filePath = "./docs/Examples/Image/circle.png"
+filePath = "./docs/Examples/Binary/circle.png"
 
 -- | Respond with image data when run
 image :: HTTPure.Request -> HTTPure.ResponseM

docs/Examples/Binary/Readme.md

@@ -0,0 +1,10 @@
+# Binary Example
+
+This is a basic example of sending binary data.  It serves an image file as
+binary data on any URL.
+
+To run the server, run:
+
+```bash
+make example EXAMPLE=Binary
+```

docs/Examples/Chunked/Main.js

@@ -0,0 +1,16 @@
+"use strict";
+
+exports.stagger = function (start) {
+  return function (end) {
+    return function (delay) {
+      var stream = new require('stream').Readable();
+      stream._read = function () {};
+      stream.push(start);
+      setTimeout(function () {
+        stream.push(end);
+        stream.push(null);
+      }, delay);
+      return stream;
+    };
+  };
+};

docs/Examples/Chunked/Main.purs

@@ -0,0 +1,39 @@
+module Examples.Chunked.Main where
+
+import Prelude
+
+import Effect.Console as Console
+import HTTPure as HTTPure
+import Node.Stream as Stream
+
+-- | Serve the example server on this port
+port :: Int
+port = 8091
+
+-- | Shortcut for `show port`
+portS :: String
+portS = show port
+
+-- | Return a readable stream that emits the first string, then the second
+-- | string, with a delay in between given by the third argument
+foreign import stagger :: String -> String -> Int -> Stream.Readable ()
+
+-- | Say 'hello world!' in chunks when run
+sayHello :: HTTPure.Request -> HTTPure.ResponseM
+sayHello _ = HTTPure.ok $ HTTPure.Chunked $ stagger "hello " "world!" 1000
+
+-- | Boot up the server
+main :: HTTPure.ServerM
+main = HTTPure.serve port sayHello do
+  Console.log $ " ┌────────────────────────────────────────────┐"
+  Console.log $ " │ Server now up on port " <> portS <> "                 │"
+  Console.log $ " │                                            │"
+  Console.log $ " │ To test, run:                              │"
+  Console.log $ " │  > curl -Nv localhost:" <> portS <> "                 │"
+  Console.log $ " │    # => ...                                │"
+  Console.log $ " │    # => < Transfer-Encoding: chunked       │"
+  Console.log $ " │    # => ...                                │"
+  Console.log $ " │    # => hello                              │"
+  Console.log $ " │    (1 second pause)                        │"
+  Console.log $ " │    # => world!                             │"
+  Console.log $ " └────────────────────────────────────────────┘"

docs/Examples/Chunked/Readme.md

@@ -0,0 +1,10 @@
+# Chunked Example
+
+This is a basic example of sending chunked data.  It will return 'hello world'
+in two separate chunks spaced a second apart on any URL.
+
+To run the example server, run:
+
+```bash
+make example EXAMPLE=Chunked
+```

src/HTTPure.purs

@@ -1,5 +1,6 @@
 module HTTPure
-  ( module HTTPure.Headers
+  ( module HTTPure.Body
+  , module HTTPure.Headers
   , module HTTPure.Lookup
   , module HTTPure.Method
   , module HTTPure.Path
@@ -10,6 +11,7 @@ module HTTPure
   , module HTTPure.Status
   ) where
 
+import HTTPure.Body (Chunked(..))
 import HTTPure.Headers (Headers, empty, header, headers)
 import HTTPure.Lookup (at, (!@), has, (!?), lookup, (!!))
 import HTTPure.Method (Method(..))

src/HTTPure/Body.purs

@@ -1,14 +1,14 @@
 module HTTPure.Body
   ( class Body
+  , Chunked(..)
+  , additionalHeaders
   , read
-  , size
   , write
   ) where
 
 import Prelude
 
 import Data.Either as Either
-import Data.Maybe as Maybe
 import Effect as Effect
 import Effect.Aff as Aff
 import Effect.Ref as Ref
@@ -17,45 +17,67 @@ import Node.Encoding as Encoding
 import Node.HTTP as HTTP
 import Node.Stream as Stream
 
+import HTTPure.Headers as Headers
+
+newtype Chunked = Chunked (Stream.Readable ())
+
 -- | Types that implement the `Body` class can be used as a body to an HTTPure
 -- | response, and can be used with all the response helpers.
 class Body b where
 
-  -- | Given a body value, return an effect that maybe calculates a size.
-  -- | TODO: This is a `Maybe` to support chunked transfer encoding.  We still
-  -- | need to add code to send the body using chunking if the effect resolves a
-  -- | `Maybe.Nothing`.
-  size :: b -> Effect.Effect (Maybe.Maybe Int)
+  -- | Return any additional headers that need to be sent with this body type.
+  -- | Things like `Content-Type`, `Content-Length`, and `Transfer-Encoding`.
+  additionalHeaders :: b -> Effect.Effect Headers.Headers
 
   -- | Given a body value and a Node HTTP `Response` value, write the body value
   -- | to the Node response.
   write :: b -> HTTP.Response -> Aff.Aff Unit
 
 -- | The instance for `String` will convert the string to a buffer first in
--- | order to determine it's size.  This is to properly handle UTF-8 characters
--- | in the string.  Writing is simply implemented by writing the string to the
+-- | order to determine it's additional headers.  This is to ensure that the
+-- | `Content-Length` header properly accounts for UTF-8 characters in the
+-- | string.  Writing is simply implemented by writing the string to the
 -- | response stream and closing the response stream.
 instance bodyString :: Body String where
-  size body = Buffer.fromString body Encoding.UTF8 >>= size
+
+  additionalHeaders body =
+    Buffer.fromString body Encoding.UTF8 >>= additionalHeaders
+
   write body response = Aff.makeAff \done -> do
     let stream = HTTP.responseAsStream response
     _ <- Stream.writeString stream Encoding.UTF8 body $ pure unit
     _ <- Stream.end stream $ pure unit
     done $ Either.Right unit
     pure Aff.nonCanceler
 
--- | The instance for `Buffer` is trivial--to calculate size, we use
--- | `Buffer.size`, and to send the response, we just write the buffer to the
--- | stream and end the stream.
+-- | The instance for `Buffer` is trivial--we add a `Content-Length` header
+-- | using `Buffer.size`, and to send the response, we just write the buffer to
+-- | the stream and end the stream.
 instance bodyBuffer :: Body Buffer.Buffer where
-  size = Buffer.size >>> map Maybe.Just
+
+  additionalHeaders buf = do
+    size <- Buffer.size buf
+    pure $ Headers.header "Content-Length" $ show size
+
   write body response = Aff.makeAff \done -> do
     let stream = HTTP.responseAsStream response
     _ <- Stream.write stream body $ pure unit
     _ <- Stream.end stream $ pure unit
     done $ Either.Right unit
     pure Aff.nonCanceler
 
+-- | This instance can be used to send chunked data.  Here, we add a
+-- | `Transfer-Encoding` header to indicate chunked data.  To write the data, we
+-- | simply pipe the newtype-wrapped `Stream` to the response.
+instance bodyChunked :: Body Chunked where
+
+  additionalHeaders _ = pure $ Headers.header "Transfer-Encoding" "chunked"
+
+  write (Chunked body) response = Aff.makeAff \done -> do
+    _ <- Stream.pipe body $ HTTP.responseAsStream response
+    Stream.onEnd body $ done $ Either.Right unit
+    pure Aff.nonCanceler
+
 -- | Extract the contents of the body of the HTTP `Request`.
 read :: HTTP.Request -> Aff.Aff String
 read request = Aff.makeAff \done -> do

src/HTTPure/Response.purs

@@ -78,7 +78,6 @@ module HTTPure.Response
 
 import Prelude
 
-import Data.Maybe as Maybe
 import Effect.Aff as Aff
 import Effect.Class as EffectClass
 import Node.HTTP as HTTP
@@ -97,21 +96,16 @@ type Response =
   { status :: Status.Status
   , headers :: Headers.Headers
   , writeBody :: HTTP.Response -> Aff.Aff Unit
-  , size :: Maybe.Maybe Int
   }
 
 -- | Given an HTTP `Response` and a HTTPure `Response`, this method will return
 -- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response`
 -- | and closing the HTTP `Response`.
 send :: HTTP.Response -> Response -> Aff.Aff Unit
-send httpresponse { status, headers, writeBody, size } = do
+send httpresponse { status, headers, writeBody } = do
   EffectClass.liftEffect $ Status.write httpresponse status
-  EffectClass.liftEffect $ Headers.write httpresponse finalHeaders
+  EffectClass.liftEffect $ Headers.write httpresponse headers
   writeBody httpresponse
-  where
-    finalHeaders = headers <> contentLength size
-    contentLength (Maybe.Just s) = Headers.header "Content-Length" $ show s
-    contentLength Maybe.Nothing = Headers.empty
 
 -- | For custom response statuses or providing a body for response codes that
 -- | don't typically send one.
@@ -124,9 +118,13 @@ response' :: forall b. Body.Body b =>
              Headers.Headers ->
              b ->
              ResponseM
-response' status headers body = do
-  size <- EffectClass.liftEffect $ Body.size body
-  pure $ { status, headers, size, writeBody: Body.write body }
+response' status headers body = EffectClass.liftEffect do
+  additionalHeaders <- Body.additionalHeaders body
+  pure
+    { status
+    , headers: headers <> additionalHeaders
+    , writeBody: Body.write body
+    }
 
 -- | The same as `response` but without a body.
 emptyResponse :: Status.Status -> ResponseM

src/HTTPure/Server.purs

@@ -33,10 +33,11 @@ handleRequest :: (Request.Request -> Response.ResponseM) ->
                  HTTP.Request ->
                  HTTP.Response ->
                  ServerM
-handleRequest router request response =
+handleRequest router request httpresponse =
   void $ Aff.runAff (\_ -> pure unit) do
     req <- Request.fromHTTPRequest request
-    router req >>= Response.send response
+    response <- router req
+    Response.send httpresponse response
 
 -- | Given a `ListenOptions` object, a function mapping `Request` to
 -- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and

test/Test/HTTPure/BodySpec.purs

@@ -2,13 +2,13 @@ module Test.HTTPure.BodySpec where
 
 import Prelude
 
-import Data.Maybe as Maybe
 import Effect.Class as EffectClass
 import Node.Buffer as Buffer
 import Node.Encoding as Encoding
 import Test.Spec as Spec
 
 import HTTPure.Body as Body
+import HTTPure.Headers as Headers
 
 import Test.HTTPure.TestHelpers as TestHelpers
 import Test.HTTPure.TestHelpers ((?=))
@@ -20,21 +20,27 @@ readSpec = Spec.describe "read" do
     body <- Body.read request
     body ?= "test"
 
-sizeSpec :: TestHelpers.Test
-sizeSpec = Spec.describe "size" do
+additionalHeadersSpec :: TestHelpers.Test
+additionalHeadersSpec = Spec.describe "additionalHeaders" do
   Spec.describe "String" do
-    Spec.it "returns the correct size for ASCII string body" do
-      size <- EffectClass.liftEffect $ Body.size "ascii"
-      size ?= Maybe.Just 5
-    Spec.it "returns the correct size for UTF-8 string body" do
-      size <- EffectClass.liftEffect $ Body.size "\x2603"  -- snowman
-      size ?= Maybe.Just 3
+    Spec.describe "with an ASCII string" do
+      Spec.it "has the correct Content-Length header" do
+        headers <- EffectClass.liftEffect $ Body.additionalHeaders "ascii"
+        headers ?= Headers.header "Content-Length" "5"
+    Spec.describe "with a UTF-8 string" do
+      Spec.it "has the correct Content-Length header" do
+        headers <- EffectClass.liftEffect $ Body.additionalHeaders "\x2603"
+        headers ?= Headers.header "Content-Length" "3"
   Spec.describe "Buffer" do
-    Spec.it "returns the correct size for binary body" do
-      size <- EffectClass.liftEffect do
-        buf <- Buffer.fromString "foobar" Encoding.UTF8
-        Body.size buf
-      size ?= Maybe.Just 6
+    Spec.it "has the correct Content-Length header" do
+      buf <- EffectClass.liftEffect $ Buffer.fromString "foobar" Encoding.UTF8
+      headers <- EffectClass.liftEffect $ Body.additionalHeaders buf
+      headers ?= Headers.header "Content-Length" "6"
+  Spec.describe "Chunked" do
+    Spec.it "specifies the Transfer-Encoding header" do
+      let body = Body.Chunked $ TestHelpers.stringToStream "test"
+      headers <- EffectClass.liftEffect $ Body.additionalHeaders body
+      headers ?= Headers.header "Transfer-Encoding" "chunked"
 
 writeSpec :: TestHelpers.Test
 writeSpec = Spec.describe "write" do
@@ -53,9 +59,17 @@ writeSpec = Spec.describe "write" do
         Body.write buf resp
         pure $ TestHelpers.getResponseBody resp
       body ?= "test"
+  Spec.describe "Chunked" do
+    Spec.it "pipes the input stream to the Response body" do
+      body <- do
+        resp <- EffectClass.liftEffect TestHelpers.mockResponse
+        let body = Body.Chunked $ TestHelpers.stringToStream "test"
+        Body.write body resp
+        pure $ TestHelpers.getResponseBody resp
+      body ?= "test"
 
 bodySpec :: TestHelpers.Test
 bodySpec = Spec.describe "Body" do
+  additionalHeadersSpec
   readSpec
-  sizeSpec
   writeSpec