#22 add support for writing headers and status (#32)

* Add support for writing status code

* Add support for writing headers

* Code cleanup

Documentation/Examples/Headers/Main.purs

@@ -0,0 +1,29 @@
+module Headers where
+
+import Prelude (discard, pure, show, (<>), ($))
+
+import Control.Monad.Eff.Console as Console
+import Data.StrMap as StrMap
+import HTTPure as HTTPure
+
+-- | Serve the example server on this port
+port :: Int
+port = 8082
+
+-- | Shortcut for `show port`
+portS :: String
+portS = show port
+
+-- | Say 'hello world!' when run
+sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e
+sayHello _ = pure $ HTTPure.OK (StrMap.singleton "X-Example" "hello world!") ""
+
+-- | Boot up the server
+main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)
+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 -v localhost:" <> portS <> "   # => ... X-Example: hello world! │"
+  Console.log $ " └──────────────────────────────────────────────────────────────┘"

Documentation/Examples/Headers/Readme.md

@@ -0,0 +1,10 @@
+# Headers Example
+
+This is a basic example of working with headers. It will return the 'X-Example'
+response header with the value 'hello world!'.
+
+To run the example server, run:
+
+```bash
+make example EXAMPLE=Headers
+```

Documentation/Examples/HelloWorld/Main.purs

@@ -21,7 +21,6 @@ sayHello _ = pure $ HTTPure.OK StrMap.empty "hello world!"
 -- | Boot up the server
 main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)
 main = HTTPure.serve port sayHello do
-  Console.log $ ""
   Console.log $ " ┌────────────────────────────────────────────┐"
   Console.log $ " │ Server now up on port " <> portS <> "                 │"
   Console.log $ " │                                            │"

Documentation/Examples/MultiRoute/Main.purs

@@ -23,7 +23,6 @@ router _                          = pure $ HTTPure.OK StrMap.empty ""
 -- | Boot up the server
 main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)
 main = HTTPure.serve port router do
-  Console.log $ ""
   Console.log $ " ┌───────────────────────────────────────────────┐"
   Console.log $ " │ Server now up on port " <> portS <> "                    │"
   Console.log $ " │                                               │"

Library/HTTPure/Body.purs

@@ -1,7 +1,26 @@
 module HTTPure.Body
   ( Body
+  , write
   ) where
 
+import Prelude (Unit, bind, discard, pure, unit)
+
+import Node.Encoding as Encoding
+import Node.HTTP as HTTP
+import Node.Stream as Stream
+
+import HTTPure.HTTPureM as HTTPureM
+
 -- | The Body type is just sugar for a String, that will be sent or received in
 -- | the HTTP body.
 type Body = String
+
+-- | Write a body to the given HTTP Response and close it.
+write :: forall e. HTTP.Response -> Body -> HTTPureM.HTTPureM e Unit
+write response body = do
+  _ <- Stream.writeString stream Encoding.UTF8 body noop
+  Stream.end stream noop
+  noop
+  where
+    stream = HTTP.responseAsStream response
+    noop = pure unit

Library/HTTPure/Headers.purs

@@ -1,9 +1,26 @@
 module HTTPure.Headers
   ( Headers
+  , write
   ) where
 
+import Prelude (Unit, bind, pure, unit, ($))
+
+import Data.Maybe as Maybe
 import Data.StrMap as StrMap
+import Data.Traversable as Traversable
+import Node.HTTP as HTTP
+
+import HTTPure.HTTPureM as HTTPureM
 
 -- | The Headers type is just sugar for a StrMap of Strings that represents the
 -- | set of headers sent or received in an HTTP request or response.
 type Headers = StrMap.StrMap String
+
+-- | Write a set of headers to the given HTTP Response.
+write :: forall e. HTTP.Response -> Headers -> HTTPureM.HTTPureM e Unit
+write response headers = do
+  _ <- Traversable.traverse writeHeader $ StrMap.keys headers
+  pure unit
+  where
+    getHeader header = Maybe.fromMaybe "" $ StrMap.lookup header headers
+    writeHeader header = HTTP.setHeader response header $ getHeader header

Library/HTTPure/Response.purs

@@ -4,15 +4,15 @@ module HTTPure.Response
   , send
   ) where
 
-import Prelude (Unit, bind, discard, pure, unit)
+import Prelude (Unit, discard, ($))
 
-import Node.Encoding as Encoding
+import Data.Maybe as Maybe
 import Node.HTTP as HTTP
-import Node.Stream as Stream
 
 import HTTPure.Body as Body
 import HTTPure.Headers as Headers
 import HTTPure.HTTPureM as HTTPureM
+import HTTPure.Status as Status
 
 -- | A response is a status, and can have headers and a body. Different response
 -- | codes will allow different response components to be sent.
@@ -24,14 +24,20 @@ data Response
 -- | methods.
 type ResponseM e = HTTPureM.HTTPureM e Response
 
+-- | Send a status, headers, and body to a HTTP response.
+send' :: forall e.
+         HTTP.Response ->
+         Status.Status ->
+         Headers.Headers ->
+         Maybe.Maybe Body.Body ->
+         HTTPureM.HTTPureM e Unit
+send' response status headers body = do
+  Status.write response status
+  Headers.write response headers
+  Body.write response $ Maybe.fromMaybe "" body
+
 -- | 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 :: forall e. HTTP.Response -> Response -> HTTPureM.HTTPureM e Unit
-send response (OK headers body) = do
-  _ <- Stream.writeString stream Encoding.UTF8 body noop
-  Stream.end stream noop
-  noop
-  where
-    stream = HTTP.responseAsStream response
-    noop = pure unit
+send response (OK headers body) = send' response 200 headers (Maybe.Just body)

Library/HTTPure/Status.purs

@@ -0,0 +1,17 @@
+module HTTPure.Status
+  ( Status
+  , write
+  ) where
+
+import Prelude (Unit)
+
+import Node.HTTP as HTTP
+
+import HTTPure.HTTPureM as HTTPureM
+
+-- | The Status type enumerates all valid HTTP response status codes.
+type Status = Int
+
+-- | Write a status to a given HTTP Response.
+write :: forall e. HTTP.Response -> Status -> HTTPureM.HTTPureM e Unit
+write = HTTP.setStatusCode

Makefile

@@ -12,7 +12,6 @@ NPM := npm
 
 # Package manifest files
 BOWERJSON := bower.json
-PACKAGEJSON := package.json
 
 # Various input directories
 SRCPATH := ./Library
@@ -25,7 +24,6 @@ EXAMPLEPATH := $(EXAMPLESPATH)/$(EXAMPLE)
 # Various output directories
 BUILD := $(OUTPUT)/Build
 COMPONENTS := $(OUTPUT)/Components
-MODULES := $(OUTPUT)/node_modules
 OUTPUT_DOCS := $(OUTPUT)/Documentation
 OUTPUT_EXAMPLE := $(OUTPUT)/Examples/$(EXAMPLE)
 
@@ -40,16 +38,12 @@ EXAMPLESOURCES := $(EXAMPLESPATH)/**/*
 # This is the module name for the entry point for the test suite
 TESTMAIN := HTTPure.HTTPureSpec
 
-$(MODULES): $(PACKAGEJSON)
-	$(NPM) install
-	mv node_modules $(MODULES)
-
 # Install bower components
 $(COMPONENTS): $(BOWERJSON)
 	$(BOWER) install
 
 # Build the source files
-$(BUILD): $(COMPONENTS) $(MODULES) $(SOURCES)
+$(BUILD): $(COMPONENTS) $(SOURCES)
 	$(PULP) build \
 	  --src-path $(SRCPATH) \
 	  --build-path $(BUILD)
@@ -92,7 +86,7 @@ test: $(BUILD) $(TESTSOURCES) $(EXAMPLESOURCES)
 	  --main $(TESTMAIN)
 
 # Launch a repl with all modules loaded
-repl: $(COMPONENTS) $(MODULES) $(SOURCES) $(TESTSOURCES) $(EXAMPLESOURCES)
+repl: $(COMPONENTS) $(SOURCES) $(TESTSOURCES) $(EXAMPLESOURCES)
 	$(PULP) repl \
 	  --include $(EXAMPLESPATH) \
 	  --src-path $(SRCPATH) \
@@ -116,7 +110,7 @@ help:
 	$(info - make help        Print this help)
 
 # Build the documentation
-$(OUTPUT_DOCS): $(COMPONENTS) $(MODULES) $(SOURCES)
+$(OUTPUT_DOCS): $(COMPONENTS) $(SOURCES)
 	$(PULP) docs \
 	  --src-path $(SRCPATH)
 	rm -rf $(OUTPUT_DOCS)

Test/HTTPure/BodySpec.purs

@@ -1,11 +1,24 @@
 module HTTPure.BodySpec where
 
-import Prelude (pure, unit)
+import Prelude (bind, discard, pure, ($))
 
+import Control.Monad.Eff.Class as EffClass
 import Test.Spec as Spec
+import Test.Spec.Assertions as Assertions
+
+import HTTPure.Body as Body
 
 import HTTPure.SpecHelpers as SpecHelpers
 
+writeSpec :: SpecHelpers.Test
+writeSpec = Spec.describe "write" do
+  Spec.it "writes the string to the Response body" do
+    body <- EffClass.liftEff do
+      resp <- SpecHelpers.mockResponse
+      Body.write resp "test"
+      pure $ SpecHelpers.getResponseBody resp
+    body `Assertions.shouldEqual` "test"
+
 bodySpec :: SpecHelpers.Test
 bodySpec = Spec.describe "Body" do
-  pure unit
+  writeSpec

Test/HTTPure/HeadersSpec.purs

@@ -1,11 +1,25 @@
 module HTTPure.HeadersSpec where
 
-import Prelude (pure, unit)
+import Prelude (bind, discard, pure, ($))
 
+import Control.Monad.Eff.Class as EffClass
+import Data.StrMap as StrMap
 import Test.Spec as Spec
+import Test.Spec.Assertions as Assertions
+
+import HTTPure.Headers as Headers
 
 import HTTPure.SpecHelpers as SpecHelpers
 
+writeSpec :: SpecHelpers.Test
+writeSpec = Spec.describe "write" do
+  Spec.it "writes the headers to the response" do
+    header <- EffClass.liftEff do
+      mock <- SpecHelpers.mockResponse
+      Headers.write mock $ StrMap.singleton "X-Test" "test"
+      pure $ SpecHelpers.getResponseHeader "X-Test" mock
+    header `Assertions.shouldEqual` "test"
+
 headersSpec :: SpecHelpers.Test
 headersSpec = Spec.describe "Headers" do
-  pure unit
+  writeSpec

Test/HTTPure/IntegrationSpec.purs

@@ -10,6 +10,7 @@ import HTTPure.SpecHelpers as SpecHelpers
 
 import HelloWorld as HelloWorld
 import MultiRoute as MultiRoute
+import Headers as Headers
 
 helloWorldSpec :: SpecHelpers.Test
 helloWorldSpec = Spec.it "runs the hello world example" do
@@ -25,7 +26,14 @@ multiRouteSpec = Spec.it "runs the multi route example" do
   goodbye <- SpecHelpers.get "http://localhost:8081/goodbye"
   goodbye `Assertions.shouldEqual` "goodbye"
 
+headersSpec :: SpecHelpers.Test
+headersSpec = Spec.it "runs the headers example" do
+  EffClass.liftEff Headers.main
+  header <- SpecHelpers.getHeader "http://localhost:8082" "X-Example"
+  header `Assertions.shouldEqual` "hello world!"
+
 integrationSpec :: SpecHelpers.Test
 integrationSpec = Spec.describe "Integration" do
   helloWorldSpec
   multiRouteSpec
+  headersSpec

Test/HTTPure/ResponseSpec.purs

@@ -1,11 +1,9 @@
 module HTTPure.ResponseSpec where
 
-import Prelude (bind, discard, ($))
+import Prelude (bind, discard, pure, ($))
 
 import Control.Monad.Eff.Class as EffClass
 import Data.StrMap as StrMap
-import Node.Encoding as Encoding
-import Node.StreamBuffer as StreamBuffer
 import Test.Spec as Spec
 import Test.Spec.Assertions as Assertions
 
@@ -16,13 +14,23 @@ import HTTPure.SpecHelpers as SpecHelpers
 sendSpec :: SpecHelpers.Test
 sendSpec = Spec.describe "send" do
   Spec.describe "with an OK" do
-    Spec.pending "writes the headers"
+    Spec.it "writes the headers" do
+      header <- EffClass.liftEff do
+        resp <- SpecHelpers.mockResponse
+        Response.send resp $ Response.OK (StrMap.singleton "X-Test" "test") ""
+        pure $ SpecHelpers.getResponseHeader "X-Test" resp
+      header `Assertions.shouldEqual` "test"
+    Spec.it "writes the status" do
+      status <- EffClass.liftEff do
+        resp <- SpecHelpers.mockResponse
+        Response.send resp $ Response.OK StrMap.empty ""
+        pure $ SpecHelpers.getResponseStatus resp
+      status `Assertions.shouldEqual` 200
     Spec.it "writes the body" do
       body <- EffClass.liftEff do
-        buf <- StreamBuffer.writable
-        let resp = SpecHelpers.mockResponse buf
+        resp <- SpecHelpers.mockResponse
         Response.send resp $ Response.OK StrMap.empty "test"
-        StreamBuffer.contents Encoding.UTF8 buf
+        pure $ SpecHelpers.getResponseBody resp
       body `Assertions.shouldEqual` "test"
 
 responseSpec :: SpecHelpers.Test

Test/HTTPure/SpecHelpers.js

@@ -0,0 +1,19 @@
+"use strict";
+
+exports.mockResponse = function() {
+    return {
+        body: "",
+        headers: {},
+
+        write: function(str) {
+            this.body = this.body + str;
+        },
+
+        end: function() {
+        },
+
+        setHeader: function(header, val) {
+            this.headers[header] = val;
+        }
+    };
+};

Test/HTTPure/SpecHelpers.purs

@@ -1,16 +1,18 @@
 module HTTPure.SpecHelpers where
 
-import Prelude (Unit, bind, discard, pure, unit, ($), (<>), (>>=))
+import Prelude (Unit, bind, discard, pure, unit, ($), (<>), (>>=), (<<<), (<$>))
 
 import Control.Monad.Aff as Aff
 import Control.Monad.Eff as Eff
 import Control.Monad.Eff.Exception as Exception
 import Control.Monad.ST as ST
+import Data.Maybe as Maybe
+import Data.String as StringUtil
+import Data.StrMap as StrMap
 import Node.Encoding as Encoding
 import Node.HTTP as HTTP
 import Node.HTTP.Client as HTTPClient
 import Node.Stream as Stream
-import Node.StreamBuffer as StreamBuffer
 import Test.Spec as Spec
 import Test.Spec.Runner as Runner
 import Unsafe.Coerce as Coerce
@@ -19,14 +21,18 @@ import Unsafe.Coerce as Coerce
 type MockRequestEffects e s =
   ( st :: ST.ST s
   , exception :: Exception.EXCEPTION
-  , http :: HTTP.HTTP | e
+  , http :: HTTP.HTTP
+  | e
+  )
+
+type MockResponseEffects e =
+  ( mockResponse :: MOCK_RESPONSE
+  | e
   )
 
 -- | A type alias encapsulating all effect types used in tests.
 type TestEffects s =
-  Runner.RunnerEffects (
-    MockRequestEffects ( sb :: StreamBuffer.STREAM_BUFFER ) s
-  )
+  Runner.RunnerEffects (MockRequestEffects (MockResponseEffects ()) s)
 
 -- | The type for integration tests.
 type Test = forall s. Spec.Spec (TestEffects s) Unit
@@ -44,10 +50,9 @@ endRequest request = Stream.end (HTTPClient.requestAsStream request) $ pure unit
 -- | client request.
 getResponse :: forall e.
                String ->
-               (Exception.Error -> Eff.Eff (http :: HTTP.HTTP | e) Unit) ->
-               (HTTPClient.Response -> Eff.Eff (http :: HTTP.HTTP | e) Unit) ->
-               Eff.Eff (http :: HTTP.HTTP | e) Unit
-getResponse url _ success = HTTPClient.requestFromURI url success >>= endRequest
+               Aff.Aff (http :: HTTP.HTTP | e) HTTPClient.Response
+getResponse url = Aff.makeAff \_ success ->
+  HTTPClient.requestFromURI url success >>= endRequest
 
 -- | Given an ST String buffer and a new string, concatenate that new string
 -- | onto the ST buffer.
@@ -67,14 +72,49 @@ toString response = Aff.makeAff \_ success -> do
 -- | Run an HTTP GET with the given url and return an Aff that contains the
 -- | string with the response body.
 get :: forall e s. String -> Aff.Aff (MockRequestEffects e s) String
-get url = Aff.makeAff (getResponse url) >>= toString
+get url = getResponse url >>= toString
+
+-- | Convert a request to an Aff containing the string with the given header
+-- | value.
+extractHeader :: String -> HTTPClient.Response -> String
+extractHeader header = unmaybe <<< lookup <<< HTTPClient.responseHeaders
+  where
+    unmaybe = Maybe.fromMaybe ""
+    lookup = StrMap.lookup $ StringUtil.toLower header
+
+-- | Run an HTTP GET with the given url and return an Aff that contains the
+-- | string with the header value for the given header.
+getHeader :: forall e s.
+             String ->
+             String ->
+             Aff.Aff (MockRequestEffects e s) String
+getHeader url header = extractHeader header <$> getResponse url
 
 -- | Mock an HTTP Request object
 mockRequest :: String -> String -> HTTP.Request
 mockRequest method url = Coerce.unsafeCoerce { method: method, url: url }
 
--- | Mock an HTTP Request object
-mockResponse :: forall e1.
-                Stream.Writable () (sb :: StreamBuffer.STREAM_BUFFER | e1) ->
-                HTTP.Response
-mockResponse = Coerce.unsafeCoerce
+-- | An effect encapsulating creating a mock response object
+foreign import data MOCK_RESPONSE :: Eff.Effect
+
+-- | Mock an HTTP Response object
+foreign import mockResponse ::
+  forall e. Eff.Eff (mockResponse :: MOCK_RESPONSE | e) HTTP.Response
+
+-- | Get the current body from an HTTP Response object (note this will only work
+-- | with an object returned from mockResponse).
+getResponseBody :: HTTP.Response -> String
+getResponseBody = _.body <<< Coerce.unsafeCoerce
+
+-- | Get the currently set status from an HTTP Response object.
+getResponseStatus :: HTTP.Response -> Int
+getResponseStatus = _.statusCode <<< Coerce.unsafeCoerce
+
+-- | Get all current headers on the HTTP Response object.
+getResponseHeaders :: HTTP.Response -> StrMap.StrMap String
+getResponseHeaders = Coerce.unsafeCoerce <<< _.headers <<< Coerce.unsafeCoerce
+
+-- | Get the current value for the header on the HTTP Response object.
+getResponseHeader :: String -> HTTP.Response -> String
+getResponseHeader header =
+  Maybe.fromMaybe "" <<< StrMap.lookup header <<< getResponseHeaders

Test/HTTPure/StatusSpec.purs

@@ -0,0 +1,24 @@
+module HTTPure.StatusSpec where
+
+import Prelude (bind, discard, pure, ($))
+
+import Control.Monad.Eff.Class as EffClass
+import Test.Spec as Spec
+import Test.Spec.Assertions as Assertions
+
+import HTTPure.Status as Status
+
+import HTTPure.SpecHelpers as SpecHelpers
+
+writeSpec :: SpecHelpers.Test
+writeSpec = Spec.describe "write" do
+  Spec.it "writes the given status code" do
+    status <- EffClass.liftEff do
+      mock <- SpecHelpers.mockResponse
+      Status.write mock 123
+      pure $ SpecHelpers.getResponseStatus mock
+    status `Assertions.shouldEqual` 123
+
+statusSpec :: SpecHelpers.Test
+statusSpec = Spec.describe "Status" do
+  writeSpec

Test/HTTPureSpec.purs

@@ -13,6 +13,7 @@ import HTTPure.PathSpec as PathSpec
 import HTTPure.RequestSpec as RequestSpec
 import HTTPure.ResponseSpec as ResponseSpec
 import HTTPure.ServerSpec as ServerSpec
+import HTTPure.StatusSpec as StatusSpec
 import HTTPure.IntegrationSpec as IntegrationSpec
 
 import HTTPure.SpecHelpers as SpecHelpers
@@ -26,4 +27,5 @@ main = Runner.run [ Reporter.specReporter ] $ Spec.describe "HTTPure" do
   RequestSpec.requestSpec
   ResponseSpec.responseSpec
   ServerSpec.serverSpec
+  StatusSpec.statusSpec
   IntegrationSpec.integrationSpec

bower.json

@@ -23,7 +23,6 @@
   "devDependencies": {
     "purescript-psci-support": "^3.0.0",
     "purescript-spec": "^1.0.0",
-    "purescript-unsafe-coerce": "^3.0.0",
-    "purescript-node-stream-buffers": "^0.1.0"
+    "purescript-unsafe-coerce": "^3.0.0"
   }
 }

package.json

@@ -1,5 +0,0 @@
-{
-  "devDependencies": {
-    "stream-buffers": "^3.0.1"
-  }
-}