Add support for reading body (#36)

Library/HTTPure/Body.purs

@@ -1,10 +1,14 @@
 module HTTPure.Body
   ( Body
+  , read
   , write
   ) 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.ST as ST
 import Node.Encoding as Encoding
 import Node.HTTP as HTTP
 import Node.Stream as Stream
@@ -15,8 +19,17 @@ import HTTPure.HTTPureM as HTTPureM
 -- | the HTTP body.
 type Body = String
 
+-- | Extract the contents of the body of the HTTP Request.
+read :: forall e. HTTP.Request -> Aff.Aff (HTTPureM.HTTPureEffects e) String
+read request = Aff.makeAff \_ success -> do
+  let stream = HTTP.requestAsStream request
+  buf <- ST.newSTRef ""
+  Stream.onDataString stream Encoding.UTF8 \str ->
+    ST.modifySTRef buf (\old -> old <> str) >>= (\_ -> pure unit)
+  Stream.onEnd stream $ ST.readSTRef buf >>= success
+
 -- | Write a body to the given HTTP Response and close it.
-write :: forall e. HTTP.Response -> Body -> HTTPureM.HTTPureM e Unit
+write :: forall e. HTTP.Response -> Body -> Eff.Eff (http :: HTTP.HTTP | e) Unit
 write response body = do
   _ <- Stream.writeString stream Encoding.UTF8 body noop
   Stream.end stream noop

Library/HTTPure/HTTPureM.purs

@@ -1,11 +1,22 @@
 module HTTPure.HTTPureM
   ( HTTPureM
+  , HTTPureEffects
   ) where
 
 import Control.Monad.Eff as Eff
+import Control.Monad.Eff.Exception as Exception
+import Control.Monad.ST as ST
 import Node.HTTP as HTTP
 
+-- | A row of types that are used by an HTTPure server.
+type HTTPureEffects e =
+  ( http :: HTTP.HTTP
+  , st :: ST.ST String
+  , exception :: Exception.EXCEPTION
+  | e
+  )
+
 -- | The `HTTPureM` monad represents effects run by an HTTPure server. It takes
 -- | an effects row parameter which enumerates all other side-effects performed
 -- | while carrying out the server actions.
-type HTTPureM e t = Eff.Eff (http :: HTTP.HTTP | e) t
+type HTTPureM e t = Eff.Eff (HTTPureEffects e) t

Library/HTTPure/Headers.purs

@@ -6,14 +6,13 @@ module HTTPure.Headers
 
 import Prelude (Unit, bind, flip, pure, unit, ($), (<<<))
 
+import Control.Monad.Eff as Eff
 import Data.Maybe as Maybe
 import Data.String as StringUtil
 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
@@ -24,7 +23,10 @@ lookup headers =
   Maybe.fromMaybe "" <<< flip StrMap.lookup headers <<< StringUtil.toLower
 
 -- | Write a set of headers to the given HTTP Response.
-write :: forall e. HTTP.Response -> Headers -> HTTPureM.HTTPureM e Unit
+write :: forall e.
+         HTTP.Response ->
+         Headers ->
+         Eff.Eff (http :: HTTP.HTTP | e) Unit
 write response headers = do
   _ <- Traversable.traverse writeHeader $ StrMap.keys headers
   pure unit

Library/HTTPure/Request.purs

@@ -3,13 +3,15 @@ module HTTPure.Request
   , fromHTTPRequest
   ) where
 
-import Prelude ((<>))
+import Prelude (bind, pure, (<>), ($))
 
+import Control.Monad.Aff as Aff
 import Data.Show as Show
 import Node.HTTP as HTTP
 
 import HTTPure.Body as Body
 import HTTPure.Headers as Headers
+import HTTPure.HTTPureM as HTTPureM
 import HTTPure.Path as Path
 
 -- | A Request is a method along with headers, a path, and sometimes a body.
@@ -28,13 +30,16 @@ instance show :: Show.Show Request where
 
 -- | Given an HTTP Request object, this method will convert it to an HTTPure
 -- | Request object.
-fromHTTPRequest :: HTTP.Request -> Request
+fromHTTPRequest :: forall e.
-fromHTTPRequest request =
+                   HTTP.Request ->
+                   Aff.Aff (HTTPureM.HTTPureEffects e) Request
+fromHTTPRequest request = do
+  body <- Body.read request
   case method of
-    "POST" -> Post headers path ""
+    "POST" -> pure $ Post headers path body
-    "PUT" -> Put headers path ""
+    "PUT" -> pure $ Put headers path body
-    "DELETE" -> Delete headers path
+    "DELETE" -> pure $ Delete headers path
-    _ -> Get headers path
+    _ -> pure $ Get headers path
   where
     method = HTTP.requestMethod request
     headers = HTTP.requestHeaders request

Library/HTTPure/Server.purs

@@ -3,8 +3,10 @@ module HTTPure.Server
   , serve
   ) where
 
-import Prelude (Unit, (>>=))
+import Prelude (Unit, bind, pure, unit, (>>=), ($))
 
+import Control.Monad.Aff as Aff
+import Control.Monad.Eff.Class as EffClass
 import Data.Maybe as Maybe
 import Node.HTTP as HTTP
 
@@ -25,8 +27,11 @@ handleRequest :: forall e.
                  HTTP.Request ->
                  HTTP.Response ->
                  ServerM e
-handleRequest router request response =
+handleRequest router request response = do
-  router (Request.fromHTTPRequest request) >>= Response.send response
+  _ <- Aff.runAff (\_ -> pure unit) (\_ -> pure unit) do
+    req <- Request.fromHTTPRequest request
+    EffClass.liftEff $ router req >>= Response.send response
+  pure unit
 
 -- | Given an options object, an function mapping Request to ResponseM, and an
 -- | HTTPureM containing effects to run on boot, creates and runs a HTTPure

Library/HTTPure/Status.purs

@@ -5,13 +5,15 @@ module HTTPure.Status
 
 import Prelude (Unit)
 
+import Control.Monad.Eff as Eff
 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 :: forall e.
+         HTTP.Response ->
+         Status ->
+         Eff.Eff (http :: HTTP.HTTP | e) Unit
 write = HTTP.setStatusCode

Makefile

@@ -63,8 +63,7 @@ $(EXAMPLE_INDEX): $(OUTPUT_EXAMPLE) $(BUILD) $(EXAMPLEPATH)/Main.purs
 	  --include $(SRCPATH) \
 	  --build-path $(BUILD) \
 	  --main $(EXAMPLE) \
-	  --to $(EXAMPLE_INDEX) \
+	  --to $(EXAMPLE_INDEX)
-	  -- --stash --censor-lib --strict
 
 # Run the example specified by the environment variable EXAMPLE
 ifeq ($(EXAMPLE),)

Test/HTTPure/BodySpec.purs

@@ -3,6 +3,7 @@ module HTTPure.BodySpec where
 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
 
@@ -10,6 +11,14 @@ import HTTPure.Body as Body
 
 import HTTPure.SpecHelpers as SpecHelpers
 
+readSpec :: SpecHelpers.Test
+readSpec = Spec.describe "read" do
+  Spec.it "returns the body of the Request" do
+    let req = SpecHelpers.mockRequest "GET" "" "test" StrMap.empty
+    request <- EffClass.liftEff req
+    body <- Body.read request
+    body `Assertions.shouldEqual` "test"
+
 writeSpec :: SpecHelpers.Test
 writeSpec = Spec.describe "write" do
   Spec.it "writes the string to the Response body" do
@@ -21,4 +30,5 @@ writeSpec = Spec.describe "write" do
 
 bodySpec :: SpecHelpers.Test
 bodySpec = Spec.describe "Body" do
+  readSpec
   writeSpec

Test/HTTPure/RequestSpec.purs

@@ -1,7 +1,8 @@
 module HTTPure.RequestSpec where
 
-import Prelude (discard, pure, show, unit, (<>), ($), (<<<))
+import Prelude (bind, discard, pure, show, unit, (<>), ($), (>>=))
 
+import Control.Monad.Eff.Class as EffClass
 import Data.StrMap as StrMap
 import Test.Spec as Spec
 import Test.Spec.Assertions as Assertions
@@ -33,69 +34,90 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
 
   Spec.describe "with a POST" do
     Spec.it "is a Post" do
-      case mock "POST" "" StrMap.empty of
+      response <- mock "POST" "" "" StrMap.empty
+      case response of
         (Request.Post _ _ _) -> pure unit
         a -> Assertions.fail $ "expected a Post, got " <> show a
     Spec.it "has the correct headers" do
-      case mock "POST" "" mockHeader of
+      response <- mock "POST" "" "" mockHeader
+      case response of
         (Request.Post headers _ _) ->
           Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test"
         a -> Assertions.fail $ "expected a Post, got " <> show a
     Spec.it "has the correct path" do
-      case mock "POST" "test" StrMap.empty of
+      response <- mock "POST" "test" "" StrMap.empty
+      case response of
         (Request.Post _ "test" _) -> pure unit
         a -> Assertions.fail $ "expected the path 'test', got " <> show a
-    Spec.pending "has the correct body"
+    Spec.it "has the correct body" do
+      response <- mock "POST" "" "test" StrMap.empty
+      case response of
+        (Request.Post _ _ "test") -> pure unit
+        a -> Assertions.fail $ "expected the body 'test', got " <> show a
 
   Spec.describe "with a PUT" do
     Spec.it "is a Put" do
-      case mock "PUT" "" StrMap.empty of
+      response <- mock "PUT" "" "" StrMap.empty
+      case response of
         (Request.Put _ _ _) -> pure unit
         a -> Assertions.fail $ "expected a Put, got " <> show a
     Spec.it "has the correct headers" do
-      case mock "PUT" "" mockHeader of
+      response <- mock "PUT" "" "" mockHeader
+      case response of
         (Request.Put headers _ _) ->
           Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test"
         a -> Assertions.fail $ "expected a Put, got " <> show a
     Spec.it "has the correct path" do
-      case mock "PUT" "test" StrMap.empty of
+      response <- mock "PUT" "test" "" StrMap.empty
+      case response of
         (Request.Put _ "test" _) -> pure unit
         a -> Assertions.fail $ "expected the path 'test', got " <> show a
-    Spec.pending "has the correct body"
+    Spec.it "has the correct body" do
+      response <- mock "PUT" "" "test" StrMap.empty
+      case response of
+        (Request.Put _ _ "test") -> pure unit
+        a -> Assertions.fail $ "expected the body 'test', got " <> show a
 
   Spec.describe "with a DELETE" do
     Spec.it "is a Delete" do
-      case mock "DELETE" "" StrMap.empty of
+      response <- mock "DELETE" "" "" StrMap.empty
+      case response of
         (Request.Delete _ _) -> pure unit
         a -> Assertions.fail $ "expected a Delete, got " <> show a
     Spec.it "has the correct headers" do
-      case mock "DELETE" "" mockHeader of
+      response <- mock "DELETE" "" "" mockHeader
+      case response of
         (Request.Delete headers _) ->
           Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test"
         a -> Assertions.fail $ "expected a Delete, got " <> show a
     Spec.it "has the correct path" do
-      case mock "DELETE" "test" StrMap.empty of
+      response <- mock "DELETE" "test" "" StrMap.empty
+      case response of
         (Request.Delete _ "test") -> pure unit
         a -> Assertions.fail $ "expected the path 'test', got " <> show a
 
   Spec.describe "with a GET" do
     Spec.it "is a Get" do
-      case mock "GET" "" StrMap.empty of
+      response <- mock "GET" "" "" StrMap.empty
+      case response of
         (Request.Get _ _) -> pure unit
         a -> Assertions.fail $ "expected a Get, got " <> show a
     Spec.it "has the correct headers" do
-      case mock "GET" "" mockHeader of
+      response <- mock "GET" "" "" mockHeader
+      case response of
         (Request.Get headers _) ->
           Headers.lookup headers "X-Test" `Assertions.shouldEqual` "test"
         a -> Assertions.fail $ "expected a Get, got " <> show a
     Spec.it "has the correct path" do
-      case mock "GET" "test" StrMap.empty of
+      response <- mock "GET" "test" "" StrMap.empty
+      case response of
         (Request.Get _ "test") -> pure unit
         a -> Assertions.fail $ "expected the path 'test', got " <> show a
 
   where
-    mock path body =
+    mock method path body headers = do
-      Request.fromHTTPRequest <<< SpecHelpers.mockRequest path body
+      let req = SpecHelpers.mockRequest method path body headers
+      EffClass.liftEff req >>= Request.fromHTTPRequest
     mockHeader = StrMap.singleton "x-test" "test"
 
 requestSpec :: SpecHelpers.Test

Test/HTTPure/SpecHelpers.js

@@ -1,5 +1,27 @@
 "use strict";
 
+exports.mockRequest = function(method) {
+    return function(url) {
+        return function(body) {
+            return function(headers) {
+                return function() {
+                    var stream = new require('stream').Readable({
+                        read: function(size) {
+                            this.push(body);
+                            this.push(null);
+                        }
+                    });
+                    stream.method = method;
+                    stream.url = url;
+                    stream.headers = headers;
+
+                    return stream;
+                };
+            };
+        };
+    };
+};
+
 exports.mockResponse = function() {
     return {
         body: "",
@@ -9,8 +31,7 @@ exports.mockResponse = function() {
             this.body = this.body + str;
         },
 
-        end: function() {
+        end: function() { },
-        },
 
         setHeader: function(header, val) {
             this.headers[header] = val;

Test/HTTPure/SpecHelpers.purs

@@ -18,27 +18,27 @@ import Test.Spec.Runner as Runner
 import Unsafe.Coerce as Coerce
 
 -- | A type alias encapsulating all effect types used in making a mock request.
-type MockRequestEffects e s =
+type HTTPRequestEffects e =
-  ( st :: ST.ST s
+  ( st :: ST.ST String
   , exception :: Exception.EXCEPTION
   , http :: HTTP.HTTP
   | e
   )
 
-type MockResponseEffects e =
+-- | A type alias encapsulating all effect types used in tests.
+type TestEffects =
+  Runner.RunnerEffects (
+    HTTPRequestEffects
       ( mockResponse :: MOCK_RESPONSE
-  | e
+      , mockRequest :: MOCK_REQUEST
+      )
   )
 
--- | A type alias encapsulating all effect types used in tests.
-type TestEffects s =
-  Runner.RunnerEffects (MockRequestEffects (MockResponseEffects ()) s)
-
 -- | The type for integration tests.
-type Test = forall s. Spec.Spec (TestEffects s) Unit
+type Test = Spec.Spec TestEffects Unit
 
 -- | The type for the entire test suite.
-type TestSuite = forall s. Eff.Eff (TestEffects s) Unit
+type TestSuite = Eff.Eff TestEffects Unit
 
 -- | Given an HTTPClient.Request, close the request stream so the request can be
 -- | fired.
@@ -61,8 +61,8 @@ concat :: forall e s.
 concat buf new = ST.modifySTRef buf (\old -> old <> new) >>= (\_ -> pure unit)
 
 -- | Convert a request to an Aff containing the string with the response body.
-toString :: forall e s.
+toString :: forall e.
-            HTTPClient.Response -> Aff.Aff (MockRequestEffects e s) String
+            HTTPClient.Response -> Aff.Aff (HTTPRequestEffects e) String
 toString response = Aff.makeAff \_ success -> do
   let stream = HTTPClient.responseAsStream response
   buf <- ST.newSTRef ""
@@ -71,7 +71,7 @@ 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 :: forall e. String -> Aff.Aff (HTTPRequestEffects e) String
 get url = getResponse url >>= toString
 
 -- | Convert a request to an Aff containing the string with the given header
@@ -84,20 +84,23 @@ extractHeader header = unmaybe <<< lookup <<< HTTPClient.responseHeaders
 
 -- | 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.
+getHeader :: forall e.
              String ->
              String ->
-             Aff.Aff (MockRequestEffects e s) String
+             Aff.Aff (HTTPRequestEffects e) String
 getHeader url header = extractHeader header <$> getResponse url
 
+-- | An effect encapsulating creating a mock request object
+foreign import data MOCK_REQUEST :: Eff.Effect
+
 -- | Mock an HTTP Request object
-mockRequest :: String -> String -> StrMap.StrMap String -> HTTP.Request
+foreign import mockRequest ::
-mockRequest method url headers =
+  forall e.
-  Coerce.unsafeCoerce
+  String ->
-    { method: method
+  String ->
-    , url: url
+  String ->
-    , headers: headers
+  StrMap.StrMap String ->
-    }
+  Eff.Eff (mockRequest :: MOCK_REQUEST | e) HTTP.Request
 
 -- | An effect encapsulating creating a mock response object
 foreign import data MOCK_RESPONSE :: Eff.Effect