WIP: consolidate APIs

Author: cprussin

src/HTTPure.purs

@@ -20,7 +20,6 @@ import HTTPure.Response
   ( Response
   , ResponseM
   , response, response'
-  , binaryResponse, binaryResponse'
   , emptyResponse, emptyResponse'
 
   -- 1xx

src/HTTPure/Body.purs

@@ -1,26 +1,29 @@
 module HTTPure.Body
-  ( Body(..)
+  ( class Body
   , read
-  , write
   , size
+  , write
   ) where
 
 import Prelude
 
 import Data.Either as Either
+import Data.Maybe as Maybe
+import Data.String as String
 import Effect as Effect
 import Effect.Aff as Aff
 import Effect.Ref as Ref
-import Node.Buffer as Buffer
 import Node.Encoding as Encoding
 import Node.HTTP as HTTP
 import Node.Stream as Stream
 
--- | The `Body` type is just sugar for a `String`, that will be sent or received
--- | in the HTTP body.
-data Body
-  = StringBody String
-  | BinaryBody Buffer.Buffer
+import HTTPure.Streamable as Streamable
+
+class Streamable.Streamable b <= Body b where
+  size :: b -> Effect.Effect (Maybe.Maybe Int)
+
+instance bodyString :: Body String where
+  size s = pure $ Maybe.Just $ String.length s
 
 -- | Extract the contents of the body of the HTTP `Request`.
 read :: HTTP.Request -> Aff.Aff String
@@ -33,18 +36,5 @@ read request = Aff.makeAff \done -> do
   pure $ Aff.nonCanceler
 
 -- | Write a `Body` to the given HTTP `Response` and close it.
-write :: HTTP.Response -> Body -> Effect.Effect Unit
-write response body = void do
-  _ <- writeToStream $ pure unit
-  Stream.end stream $ pure unit
-  where
-    stream = HTTP.responseAsStream response
-    writeToStream =
-      case body of
-        StringBody str -> Stream.writeString stream Encoding.UTF8 str
-        BinaryBody buf -> Stream.write stream buf
-
--- | Get the size of the body in bytes
-size :: Body -> Effect.Effect Int
-size (StringBody body) = Buffer.fromString body Encoding.UTF8 >>= Buffer.size
-size (BinaryBody body) = Buffer.size body
+write :: HTTP.Response -> Stream.Readable () -> Effect.Effect Unit
+write response body = void $ Stream.pipe body $ HTTP.responseAsStream response

src/HTTPure/Response.purs

@@ -3,7 +3,6 @@ module HTTPure.Response
   , ResponseM
   , send
   , response, response'
-  , binaryResponse, binaryResponse'
   , emptyResponse, emptyResponse'
 
   -- 1xx
@@ -79,14 +78,17 @@ module HTTPure.Response
 
 import Prelude
 
+import Data.Maybe as Maybe
 import Effect as Effect
 import Effect.Aff as Aff
-import Node.Buffer as Buffer
+import Effect.Class as EffectClass
 import Node.HTTP as HTTP
+import Node.Stream as Stream
 
 import HTTPure.Body as Body
 import HTTPure.Headers as Headers
 import HTTPure.Status as Status
+import HTTPure.Streamable as Streamable
 
 -- | The `ResponseM` type simply conveniently wraps up an HTTPure monad that
 -- | returns a response. This type is the return type of all router/route
@@ -97,53 +99,44 @@ type ResponseM = Aff.Aff Response
 type Response =
   { status :: Status.Status
   , headers :: Headers.Headers
-  , body :: Body.Body
+  , body :: Stream.Readable ()
+  , 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 -> Effect.Effect Unit
-send httpresponse { status, headers, body } = do
+send httpresponse { status, headers, body, size } = do
   Status.write httpresponse $ status
-  size <- Body.size body
   Headers.write httpresponse $ headers <> contentLength size
   Body.write httpresponse $ body
   where
-    contentLength size = Headers.header "Content-Length" $ show 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.
-response :: Status.Status -> String -> ResponseM
+response :: forall b. Body.Body b => Status.Status -> b -> ResponseM
 response status = response' status Headers.empty
 
 -- | The same as `response` but with headers.
-response' :: Status.Status ->
+response' :: forall b. Body.Body b =>
+             Status.Status ->
              Headers.Headers ->
-             String ->
+             b ->
              ResponseM
-response' status headers body =
-  pure $ { status, headers, body: Body.StringBody body }
-
--- | Like `response`, but the response body is binary data.
-binaryResponse :: Status.Status -> Buffer.Buffer -> Aff.Aff Response
-binaryResponse status = binaryResponse' status Headers.empty
-
--- | The same as `binaryResponse` but with headers.
-binaryResponse' :: Status.Status ->
-                   Headers.Headers ->
-                   Buffer.Buffer ->
-                   Aff.Aff Response
-binaryResponse' status headers body
-  = pure $ { status, headers, body: Body.BinaryBody body }
+response' status headers body = do
+  size <- EffectClass.liftEffect $ Body.size body
+  pure $ { status , headers , size , body: Streamable.toStream body }
 
 -- | The same as `response` but without a body.
 emptyResponse :: Status.Status -> ResponseM
 emptyResponse status = emptyResponse' status Headers.empty
 
 -- | The same as `emptyResponse` but with headers.
 emptyResponse' :: Status.Status -> Headers.Headers -> ResponseM
-emptyResponse' status headers = response' status headers ""
+emptyResponse' status headers = response' status headers $ ""
 
 ---------
 -- 1xx --
@@ -178,11 +171,11 @@ processing' = emptyResponse' Status.processing
 ---------
 
 -- | 200
-ok :: String -> ResponseM
+ok :: forall b. Body.Body b => b -> ResponseM
 ok = ok' Headers.empty
 
 -- | 200 with headers
-ok' :: Headers.Headers -> String -> ResponseM
+ok' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 ok' = response' Status.ok
 
 -- | 201
@@ -202,12 +195,13 @@ accepted' :: Headers.Headers -> ResponseM
 accepted' = emptyResponse' Status.accepted
 
 -- | 203
-nonAuthoritativeInformation :: String -> ResponseM
+nonAuthoritativeInformation :: forall b. Body.Body b => b -> ResponseM
 nonAuthoritativeInformation = nonAuthoritativeInformation' Headers.empty
 
 -- | 203 with headers
-nonAuthoritativeInformation' :: Headers.Headers ->
-                                String ->
+nonAuthoritativeInformation' :: forall b. Body.Body b =>
+                                Headers.Headers ->
+                                b ->
                                 ResponseM
 nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation
 
@@ -228,19 +222,19 @@ resetContent' :: Headers.Headers -> ResponseM
 resetContent' = emptyResponse' Status.resetContent
 
 -- | 206
-partialContent :: String -> ResponseM
+partialContent :: forall b. Body.Body b => b -> ResponseM
 partialContent = partialContent' Headers.empty
 
 -- | 206 with headers
-partialContent' :: Headers.Headers -> String -> ResponseM
+partialContent' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 partialContent' = response' Status.partialContent
 
 -- | 207
-multiStatus :: String -> ResponseM
+multiStatus :: forall b. Body.Body b => b -> ResponseM
 multiStatus = multiStatus' Headers.empty
 
 -- | 207 with headers
-multiStatus' :: Headers.Headers -> String -> ResponseM
+multiStatus' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 multiStatus' = response' Status.multiStatus
 
 -- | 208
@@ -252,47 +246,47 @@ alreadyReported' :: Headers.Headers -> ResponseM
 alreadyReported' = emptyResponse' Status.alreadyReported
 
 -- | 226
-iMUsed :: String -> ResponseM
+iMUsed :: forall b. Body.Body b => b -> ResponseM
 iMUsed = iMUsed' Headers.empty
 
 -- | 226 with headers
-iMUsed' :: Headers.Headers -> String -> ResponseM
+iMUsed' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 iMUsed' = response' Status.iMUsed
 
 ---------
 -- 3xx --
 ---------
 
 -- | 300
-multipleChoices :: String -> ResponseM
+multipleChoices :: forall b. Body.Body b => b -> ResponseM
 multipleChoices = multipleChoices' Headers.empty
 
 -- | 300 with headers
-multipleChoices' :: Headers.Headers -> String -> ResponseM
+multipleChoices' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 multipleChoices' = response' Status.multipleChoices
 
 -- | 301
-movedPermanently :: String -> ResponseM
+movedPermanently :: forall b. Body.Body b => b -> ResponseM
 movedPermanently = movedPermanently' Headers.empty
 
 -- | 301 with headers
-movedPermanently' :: Headers.Headers -> String -> ResponseM
+movedPermanently' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 movedPermanently' = response' Status.movedPermanently
 
 -- | 302
-found :: String -> ResponseM
+found :: forall b. Body.Body b => b -> ResponseM
 found = found' Headers.empty
 
 -- | 302 with headers
-found' :: Headers.Headers -> String -> ResponseM
+found' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 found' = response' Status.found
 
 -- | 303
-seeOther :: String -> ResponseM
+seeOther :: forall b. Body.Body b => b -> ResponseM
 seeOther = seeOther' Headers.empty
 
 -- | 303 with headers
-seeOther' :: Headers.Headers -> String -> ResponseM
+seeOther' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 seeOther' = response' Status.seeOther
 
 -- | 304
@@ -304,27 +298,27 @@ notModified' :: Headers.Headers -> ResponseM
 notModified' = emptyResponse' Status.notModified
 
 -- | 305
-useProxy :: String -> ResponseM
+useProxy :: forall b. Body.Body b => b -> ResponseM
 useProxy = useProxy' Headers.empty
 
 -- | 305 with headers
-useProxy' :: Headers.Headers -> String -> ResponseM
+useProxy' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 useProxy' = response' Status.useProxy
 
 -- | 307
-temporaryRedirect :: String -> ResponseM
+temporaryRedirect :: forall b. Body.Body b => b -> ResponseM
 temporaryRedirect = temporaryRedirect' Headers.empty
 
 -- | 307 with headers
-temporaryRedirect' :: Headers.Headers -> String -> ResponseM
+temporaryRedirect' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 temporaryRedirect' = response' Status.temporaryRedirect
 
 -- | 308
-permanentRedirect :: String -> ResponseM
+permanentRedirect :: forall b. Body.Body b => b -> ResponseM
 permanentRedirect = permanentRedirect' Headers.empty
 
 -- | 308 with headers
-permanentRedirect' :: Headers.Headers -> String -> ResponseM
+permanentRedirect' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 permanentRedirect' = response' Status.permanentRedirect
 
 
@@ -333,11 +327,11 @@ permanentRedirect' = response' Status.permanentRedirect
 ---------
 
 -- | 400
-badRequest :: String -> ResponseM
+badRequest :: forall b. Body.Body b => b -> ResponseM
 badRequest = badRequest' Headers.empty
 
 -- | 400 with headers
-badRequest' :: Headers.Headers -> String -> ResponseM
+badRequest' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 badRequest' = response' Status.badRequest
 
 -- | 401
@@ -405,11 +399,11 @@ requestTimeout' :: Headers.Headers -> ResponseM
 requestTimeout' = emptyResponse' Status.requestTimeout
 
 -- | 409
-conflict :: String -> ResponseM
+conflict :: forall b. Body.Body b => b -> ResponseM
 conflict = conflict' Headers.empty
 
 -- | 409 with headers
-conflict' :: Headers.Headers -> String -> ResponseM
+conflict' :: forall b. Body.Body b => Headers.Headers -> b -> ResponseM
 conflict' = response' Status.conflict
 
 -- | 410
@@ -561,11 +555,14 @@ unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons
 ---------
 
 -- | 500
-internalServerError :: String -> ResponseM
+internalServerError :: forall b. Body.Body b => b -> ResponseM
 internalServerError = internalServerError' Headers.empty
 
 -- | 500 with headers
-internalServerError' :: Headers.Headers -> String -> ResponseM
+internalServerError' :: forall b. Body.Body b =>
+                        Headers.Headers ->
+                        b ->
+                        ResponseM
 internalServerError' = response' Status.internalServerError
 
 -- | 501

src/HTTPure/Streamable.js

@@ -0,0 +1,9 @@
+"use strict";
+
+exports.createStreamFromString = function (str) {
+  var stream = new require('stream').Readable();
+  stream._read = function () {};
+  stream.push(str);
+  stream.push(null);
+  return stream;
+}

src/HTTPure/Streamable.purs

@@ -0,0 +1,14 @@
+module HTTPure.Streamable
+  ( class Streamable
+  , toStream
+  ) where
+
+import Node.Stream as Stream
+
+foreign import createStreamFromString :: String -> Stream.Readable ()
+
+class Streamable s where
+  toStream :: s -> Stream.Readable ()
+
+instance streamableString :: Streamable String where
+  toStream = createStreamFromString