Add support for non string requests (#184)

* First version of supporting non-string requests

* Clean up

* Minor cleanup

* Simplify to directly export the stream

* Add nl

* Clean up & add more testing

Co-authored-by: sigma-andex <sigma.andex@pm.me>

docs/Examples/Binary/Readme.md

@@ -1,10 +0,0 @@
-# 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/BinaryRequest/Main.js

@@ -0,0 +1,7 @@
+'use strict';
+
+const crypto = require('crypto');
+
+exports.sha256sum = function(buffer) {
+  return crypto.createHash('sha256').update(buffer).digest('hex');
+}

docs/Examples/BinaryRequest/Main.purs

@@ -0,0 +1,24 @@
+module Examples.BinaryRequest.Main where
+
+import Prelude
+import Effect.Console as Console
+import Node.Buffer (Buffer)
+import HTTPure as HTTPure
+
+foreign import sha256sum :: Buffer -> String
+
+-- | Respond with file's sha256sum
+router :: HTTPure.Request -> HTTPure.ResponseM
+router { body } = HTTPure.toBuffer body >>= sha256sum >>> HTTPure.ok
+
+-- | Boot up the server
+main :: HTTPure.ServerM
+main =
+  HTTPure.serve 8080 router do
+    Console.log $ " ┌─────────────────────────────────────────────────────────┐"
+    Console.log $ " │ Server now up on port 8080                              │"
+    Console.log $ " │                                                         │"
+    Console.log $ " │ To test, run:                                           │"
+    Console.log $ " │  > curl -XPOST --data-binary @circle.png localhost:8080 │"
+    Console.log $ " │                          # => d5e776724dd5...           │"
+    Console.log $ " └─────────────────────────────────────────────────────────┘"

docs/Examples/BinaryRequest/Readme.md

@@ -0,0 +1,10 @@
+# Binary Request Example
+
+This is a basic example of sending binary request data.  It will read in the
+binary file and send back the file's sha256 checksum.
+
+To run the server, run:
+
+```bash
+make example EXAMPLE=BinaryRequest
+```

docs/Examples/BinaryResponse/Main.purs

@@ -1,4 +1,4 @@
-module Examples.Binary.Main where
+module Examples.BinaryResponse.Main where
 
 import Prelude
 import Effect.Console as Console
@@ -7,7 +7,7 @@ import HTTPure as HTTPure
 
 -- | The path to the file containing the response to send
 filePath :: String
-filePath = "./docs/Examples/Binary/circle.png"
+filePath = "./docs/Examples/BinaryResponse/circle.png"
 
 responseHeaders :: HTTPure.Headers
 responseHeaders = HTTPure.header "Content-Type" "image/png"

docs/Examples/BinaryResponse/Readme.md

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

docs/Examples/Post/Main.purs

@@ -6,7 +6,7 @@ import HTTPure as HTTPure
 
 -- | Route to the correct handler
 router :: HTTPure.Request -> HTTPure.ResponseM
-router { body, method: HTTPure.Post } = HTTPure.ok body
+router { body, method: HTTPure.Post } = HTTPure.toString body >>= HTTPure.ok
 router _ = HTTPure.notFound
 
 -- | Boot up the server

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 (toString, toBuffer)
 import HTTPure.Headers (Headers, empty, header, headers)
 import HTTPure.Lookup (at, (!@), has, (!?), lookup, (!!))
 import HTTPure.Method (Method(..))

src/HTTPure/Body.purs

@@ -1,13 +1,16 @@
 module HTTPure.Body
   ( class Body
   , defaultHeaders
-  , read
   , write
+  , read
+  , toString
+  , toBuffer
   ) where
 
 import Prelude
 import Data.Either as Either
 import Effect as Effect
+import Effect.Class (liftEffect)
 import Effect.Aff as Aff
 import Effect.Ref as Ref
 import HTTPure.Headers as Headers
@@ -17,6 +20,26 @@ import Node.HTTP as HTTP
 import Node.Stream as Stream
 import Type.Equality as TypeEquals
 
+-- | Read the body `Readable` stream out of the incoming request
+read :: HTTP.Request -> Stream.Readable ()
+read = HTTP.requestAsStream
+
+-- | Slurp the entire `Readable` stream into a `String`
+toString :: Stream.Readable () -> Aff.Aff String
+toString = toBuffer >=> Buffer.toString Encoding.UTF8 >>> liftEffect
+
+-- | Slurp the entire `Readable` stream into a `Buffer`
+toBuffer :: Stream.Readable () -> Aff.Aff Buffer.Buffer
+toBuffer stream =
+  Aff.makeAff \done -> do
+    bufs <- Ref.new []
+    Stream.onData stream \buf ->
+      void $ Ref.modify (_ <> [ buf ]) bufs
+    Stream.onEnd stream do
+      body <- Ref.read bufs >>= Buffer.concat
+      done $ Either.Right body
+    pure Aff.nonCanceler
+
 -- | 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
@@ -77,17 +100,3 @@ instance bodyChunked ::
       void $ Stream.pipe stream $ HTTP.responseAsStream response
       Stream.onEnd stream $ 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
-    let
-      stream = HTTP.requestAsStream request
-    bufs <- Ref.new []
-    Stream.onData stream \buf ->
-      void $ Ref.modify (_ <> [ buf ]) bufs
-    Stream.onEnd stream do
-      body <- Ref.read bufs >>= Buffer.concat >>= Buffer.toString Encoding.UTF8
-      done $ Either.Right body
-    pure Aff.nonCanceler

src/HTTPure/Request.purs

@@ -9,6 +9,7 @@ import Effect.Aff as Aff
 import Data.String as String
 import Foreign.Object as Object
 import Node.HTTP as HTTP
+import Node.Stream as Stream
 import HTTPure.Body as Body
 import HTTPure.Headers as Headers
 import HTTPure.Method as Method
@@ -24,7 +25,7 @@ type Request =
   , path :: Path.Path
   , query :: Query.Query
   , headers :: Headers.Headers
-  , body :: String
+  , body :: Stream.Readable ()
   , httpVersion :: Version.Version
   , url :: String
   }
@@ -48,14 +49,12 @@ fullPath request = "/" <> path <> questionMark <> queryParams
 -- | Given an HTTP `Request` object, this method will convert it to an HTTPure
 -- | `Request` object.
 fromHTTPRequest :: HTTP.Request -> Aff.Aff Request
-fromHTTPRequest request = do
+fromHTTPRequest request = pure
-  body <- Body.read request
+  { method: Method.read request
-  pure $
+  , path: Path.read request
-    { method: Method.read request
+  , query: Query.read request
-    , path: Path.read request
+  , headers: Headers.read request
-    , query: Query.read request
+  , body: Body.read request
-    , headers: Headers.read request
+  , httpVersion: Version.read request
-    , body
+  , url: HTTP.requestURL request
-    , httpVersion: Version.read request
+  }
-    , url: HTTP.requestURL request
-    }

test/Test/HTTPure/BodySpec.purs

@@ -1,22 +1,39 @@
 module Test.HTTPure.BodySpec where
 
 import Prelude
+import Data.Maybe (Maybe(Nothing), fromMaybe)
 import Effect.Class as EffectClass
 import Node.Buffer as Buffer
 import Node.Encoding as Encoding
+import Node.Stream as Stream
 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 ((?=))
+import Test.HTTPure.TestHelpers ((?=), stringToStream)
 
 readSpec :: TestHelpers.Test
 readSpec =
   Spec.describe "read" do
     Spec.it "is the body of the Request" do
-      request <- TestHelpers.mockRequest "" "GET" "" "test" []
+      body <- Body.read <$> TestHelpers.mockRequest "" "GET" "" "test" []
-      body <- Body.read request
+      string <- EffectClass.liftEffect $ fromMaybe "" <$> Stream.readString body Nothing Encoding.UTF8
-      body ?= "test"
+      string ?= "test"
+
+toStringSpec :: TestHelpers.Test
+toStringSpec =
+  Spec.describe "toString" do
+    Spec.it "slurps Streams into Strings" do
+      string <- Body.toString $ stringToStream "foobar"
+      string ?= "foobar"
+
+toBufferSpec :: TestHelpers.Test
+toBufferSpec =
+  Spec.describe "toBuffer" do
+    Spec.it "slurps Streams into Buffers" do
+      buf <- Body.toBuffer $ stringToStream "foobar"
+      string <- EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 buf
+      string ?= "foobar"
 
 defaultHeadersSpec :: TestHelpers.Test
 defaultHeadersSpec =
@@ -73,4 +90,6 @@ bodySpec =
   Spec.describe "Body" do
     defaultHeadersSpec
     readSpec
+    toStringSpec
+    toBufferSpec
     writeSpec

test/Test/HTTPure/IntegrationSpec.purs

@@ -9,7 +9,8 @@ import Test.Spec as Spec
 import Test.HTTPure.TestHelpers as TestHelpers
 import Test.HTTPure.TestHelpers ((?=))
 import Examples.AsyncResponse.Main as AsyncResponse
-import Examples.Binary.Main as Binary
+import Examples.BinaryRequest.Main as BinaryRequest
+import Examples.BinaryResponse.Main as BinaryResponse
 import Examples.Chunked.Main as Chunked
 import Examples.CustomStack.Main as CustomStack
 import Examples.Headers.Main as Headers
@@ -29,13 +30,22 @@ asyncResponseSpec =
     EffectClass.liftEffect $ close $ pure unit
     response ?= "hello world!"
 
-binarySpec :: TestHelpers.Test
+binaryRequestSpec :: TestHelpers.Test
-binarySpec =
+binaryRequestSpec =
-  Spec.it "runs the binary example" do
+  Spec.it "runs the binary request example" do
-    close <- EffectClass.liftEffect Binary.main
+    close <- EffectClass.liftEffect BinaryRequest.main
+    binaryBuf <- FS.readFile BinaryResponse.filePath
+    response <- TestHelpers.postBinary 8080 Object.empty "/" binaryBuf
+    EffectClass.liftEffect $ close $ pure unit
+    response ?= "d5e776724dd545d8b54123b46362a553d10257cee688ef1be62166c984b34405"
+
+binaryResponseSpec :: TestHelpers.Test
+binaryResponseSpec =
+  Spec.it "runs the binary response example" do
+    close <- EffectClass.liftEffect BinaryResponse.main
     responseBuf <- TestHelpers.getBinary 8080 Object.empty "/"
     EffectClass.liftEffect $ close $ pure unit
-    binaryBuf <- FS.readFile Binary.filePath
+    binaryBuf <- FS.readFile BinaryResponse.filePath
     expected <- EffectClass.liftEffect $ Buffer.toArray binaryBuf
     response <- EffectClass.liftEffect $ Buffer.toArray responseBuf
     response ?= expected
@@ -144,7 +154,8 @@ integrationSpec :: TestHelpers.Test
 integrationSpec =
   Spec.describe "Integration" do
     asyncResponseSpec
-    binarySpec
+    binaryRequestSpec
+    binaryResponseSpec
     chunkedSpec
     customStackSpec
     headersSpec

test/Test/HTTPure/RequestSpec.purs

@@ -4,6 +4,7 @@ import Prelude
 import Data.Tuple as Tuple
 import Foreign.Object as Object
 import Test.Spec as Spec
+import HTTPure.Body as Body
 import HTTPure.Headers as Headers
 import HTTPure.Method as Method
 import HTTPure.Request as Request
@@ -27,8 +28,8 @@ fromHTTPRequestSpec =
       mock <- mockRequest
       mock.headers ?= Headers.headers mockHeaders
     Spec.it "contains the correct body" do
-      mock <- mockRequest
+      mockBody <- mockRequest >>= _.body >>> Body.toString
-      mock.body ?= "body"
+      mockBody ?= "body"
     Spec.it "contains the correct httpVersion" do
       mock <- mockRequest
       mock.httpVersion ?= Version.HTTP1_1

test/Test/HTTPure/TestHelpers.purs

@@ -40,7 +40,7 @@ request ::
   String ->
   Object.Object String ->
   String ->
-  String ->
+  Buffer.Buffer ->
   Aff.Aff HTTPClient.Response
 request secure port method headers path body =
   Aff.makeAff \done -> do
@@ -48,7 +48,7 @@ request secure port method headers path body =
     let
       stream = HTTPClient.requestAsStream req
     void
-      $ Stream.writeString stream Encoding.UTF8 body
+      $ Stream.write stream body
       $ Stream.end stream
       $ pure unit
     pure Aff.nonCanceler
@@ -62,6 +62,31 @@ request secure port method headers path body =
       <> HTTPClient.headers := HTTPClient.RequestHeaders headers
       <> HTTPClient.rejectUnauthorized := false
 
+-- | Same as `request` but without.
+request' ::
+  Boolean ->
+  Int ->
+  String ->
+  Object.Object String ->
+  String ->
+  Aff.Aff HTTPClient.Response
+request' secure port method headers path =
+  EffectClass.liftEffect (Buffer.create 0)
+    >>= request secure port method headers path
+
+-- | Same as `request` but with a `String` body.
+requestString ::
+  Boolean ->
+  Int ->
+  String ->
+  Object.Object String ->
+  String ->
+  String ->
+  Aff.Aff HTTPClient.Response
+requestString secure port method headers path body = do
+  EffectClass.liftEffect (Buffer.fromString body Encoding.UTF8)
+    >>= request secure port method headers path
+
 -- | Convert a request to an Aff containing the `Buffer with the response body.
 toBuffer :: HTTPClient.Response -> Aff.Aff Buffer.Buffer
 toBuffer response =
@@ -91,7 +116,7 @@ get ::
   Object.Object String ->
   String ->
   Aff.Aff String
-get port headers path = request false port "GET" headers path "" >>= toString
+get port headers path = request' false port "GET" headers path >>= toString
 
 -- | Like `get` but return a response body in a `Buffer`
 getBinary ::
@@ -99,7 +124,7 @@ getBinary ::
   Object.Object String ->
   String ->
   Aff.Aff Buffer.Buffer
-getBinary port headers path = request false port "GET" headers path "" >>= toBuffer
+getBinary port headers path = request' false port "GET" headers path >>= toBuffer
 
 -- | Run an HTTPS GET with the given url and return an Aff that contains the
 -- | string with the response body.
@@ -108,7 +133,7 @@ get' ::
   Object.Object String ->
   String ->
   Aff.Aff String
-get' port headers path = request true port "GET" headers path "" >>= toString
+get' port headers path = request' true port "GET" headers path >>= toString
 
 -- | Run an HTTP POST with the given url and body and return an Aff that
 -- | contains the string with the response body.
@@ -118,7 +143,17 @@ post ::
   String ->
   String ->
   Aff.Aff String
-post port headers path = request false port "POST" headers path >=> toString
+post port headers path = requestString false port "POST" headers path >=> toString
+
+-- | Run an HTTP POST with the given url and binary buffer body and return an
+-- | Aff that contains the string with the response body.
+postBinary ::
+  Int ->
+  Object.Object String ->
+  String ->
+  Buffer.Buffer ->
+  Aff.Aff String
+postBinary port headers path = request false port "POST" headers path >=> toString
 
 -- | Convert a request to an Aff containing the string with the given header
 -- | value.
@@ -137,14 +172,14 @@ getHeader ::
   String ->
   String ->
   Aff.Aff String
-getHeader port headers path header = extractHeader header <$> request false port "GET" headers path ""
+getHeader port headers path header = extractHeader header <$> request' false port "GET" headers path
 
 getStatus ::
   Int ->
   Object.Object String ->
   String ->
   Aff.Aff Int
-getStatus port headers path = HTTPClient.statusCode <$> request false port "GET" headers path ""
+getStatus port headers path = HTTPClient.statusCode <$> request' false port "GET" headers path
 
 -- | Mock an HTTP Request object
 foreign import mockRequestImpl ::