Cache Body toBuffer/toString Results (#189)

* cache `body` processing results (Buffer, String) with `Ref`

* add `readBodyAs(Buffer|Stream|String)` for accessing `body`

* fix tests

* add tests for `readBodyAsBuffer` and `readBodyAsString`

* move Body to HTTPure.Body and rename it to RequestBody

* add HTTPure.Body.toStream

* consolidate `readBodyAs(Buffer|String)` into `to(Buffer|String)`

and move `Ref` from top level `body` down to `buffer` and `string` fields

* fix tests

* import constructors explicitly

* revert changes

This reverts commit e53188c3e6d74ca00d3d891829ca91f0803b870b.

* update `Body.read` to return `RequestBody`

src/HTTPure.purs

@@ -11,7 +11,7 @@ module HTTPure
   , module HTTPure.Status
   ) where
 
-import HTTPure.Body (toString, toBuffer)
+import HTTPure.Body (toBuffer, toStream, toString)
 import HTTPure.Headers (Headers, empty, header, headers)
 import HTTPure.Lookup (at, (!@), has, (!?), lookup, (!!))
 import HTTPure.Method (Method(..))

src/HTTPure/Body.purs

@@ -1,46 +1,98 @@
 module HTTPure.Body
   ( class Body
+  , RequestBody
   , defaultHeaders
   , write
   , read
-  , toString
   , toBuffer
+  , toStream
+  , toString
   ) where
 
 import Prelude
 import Data.Either (Either(Right))
+import Data.Maybe (Maybe(Just, Nothing))
 import Effect (Effect)
-import Effect.Class (liftEffect)
 import Effect.Aff (Aff, makeAff, nonCanceler)
-import Effect.Ref (read) as Ref
-import Effect.Ref (new, modify)
+import Effect.Class (liftEffect)
+import Effect.Ref (Ref)
+import Effect.Ref (read, modify, new, write) as Ref
 import HTTPure.Headers (Headers, header)
-import Node.Buffer (toString) as Buffer
 import Node.Buffer (Buffer, concat, fromString, size)
+import Node.Buffer (toString) as Buffer
 import Node.Encoding (Encoding(UTF8))
 import Node.HTTP (Request, Response, requestAsStream, responseAsStream)
-import Node.Stream (write) as Stream
 import Node.Stream (Stream, Readable, onData, onEnd, writeString, pipe, end)
+import Node.Stream (write) as Stream
 import Type.Equality (class TypeEquals, to)
 
+type RequestBody =
+  { buffer :: Ref (Maybe Buffer)
+  , stream :: Readable ()
+  , string :: Ref (Maybe String)
+  }
+
 -- | Read the body `Readable` stream out of the incoming request
-read :: Request -> Readable ()
-read = requestAsStream
+read :: Request -> Effect RequestBody
+read request = do
+  buffer <- Ref.new Nothing
+  string <- Ref.new Nothing
+  pure
+    { buffer
+    , stream: requestAsStream request
+    , string
+    }
 
--- | Slurp the entire `Readable` stream into a `String`
-toString :: Readable () -> Aff String
-toString = toBuffer >=> Buffer.toString UTF8 >>> liftEffect
+-- | Turn `RequestBody` into a `String`
+-- |
+-- | This drains the `Readable` stream in `RequestBody` for the first time
+-- | and returns cached result from then on.
+toString :: RequestBody -> Aff String
+toString requestBody = do
+  maybeString <-
+    liftEffect
+      $ Ref.read requestBody.string
+  case maybeString of
+    Nothing -> do
+      buffer <- toBuffer requestBody
+      string <- liftEffect
+        $ Buffer.toString UTF8 buffer
+      liftEffect
+        $ Ref.write (Just string) requestBody.string
+      pure string
+    Just string -> pure string
 
--- | Slurp the entire `Readable` stream into a `Buffer`
-toBuffer :: Readable () -> Aff Buffer
-toBuffer stream =
-  makeAff \done -> do
-    bufs <- new []
-    onData stream \buf -> void $ modify (_ <> [ buf ]) bufs
-    onEnd stream do
-      body <- Ref.read bufs >>= concat
-      done $ Right body
-    pure nonCanceler
+-- | Turn `RequestBody` into a `Buffer`
+-- |
+-- | This drains the `Readable` stream in `RequestBody` for the first time
+-- | and returns cached result from then on.
+toBuffer :: RequestBody -> Aff Buffer
+toBuffer requestBody = do
+  maybeBuffer <-
+    liftEffect
+      $ Ref.read requestBody.buffer
+  case maybeBuffer of
+    Nothing -> do
+      buffer <- streamToBuffer requestBody.stream
+      liftEffect
+        $ Ref.write (Just buffer) requestBody.buffer
+      pure buffer
+    Just buffer -> pure buffer
+  where
+  -- | Slurp the entire `Readable` stream into a `Buffer`
+  streamToBuffer :: Readable () -> Aff Buffer
+  streamToBuffer stream =
+    makeAff \done -> do
+      bufs <- Ref.new []
+      onData stream \buf -> void $ Ref.modify (_ <> [ buf ]) bufs
+      onEnd stream do
+        body <- Ref.read bufs >>= concat
+        done $ Right body
+      pure nonCanceler
+
+-- | Return the `Readable` stream directly from `RequestBody`
+toStream :: RequestBody -> Readable ()
+toStream = _.stream
 
 -- | 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.

src/HTTPure/Request.purs

@@ -5,12 +5,11 @@ module HTTPure.Request
   ) where
 
 import Prelude
-import Effect.Aff (Aff)
 import Data.String (joinWith)
+import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
 import Foreign.Object (isEmpty, toArrayWithKey)
-import Node.HTTP (requestURL)
-import Node.HTTP (Request) as HTTP
-import Node.Stream (Readable)
+import HTTPure.Body (RequestBody)
 import HTTPure.Body (read) as Body
 import HTTPure.Headers (Headers)
 import HTTPure.Headers (read) as Headers
@@ -23,6 +22,8 @@ import HTTPure.Query (read) as Query
 import HTTPure.Utils (encodeURIComponent)
 import HTTPure.Version (Version)
 import HTTPure.Version (read) as Version
+import Node.HTTP (Request) as HTTP
+import Node.HTTP (requestURL)
 
 -- | The `Request` type is a `Record` type that includes fields for accessing
 -- | the different parts of the HTTP request.
@@ -31,7 +32,7 @@ type Request =
   , path :: Path
   , query :: Query
   , headers :: Headers
-  , body :: Readable ()
+  , body :: RequestBody
   , httpVersion :: Version
   , url :: String
   }
@@ -51,12 +52,15 @@ fullPath request = "/" <> path <> questionMark <> queryParams
 -- | Given an HTTP `Request` object, this method will convert it to an HTTPure
 -- | `Request` object.
 fromHTTPRequest :: HTTP.Request -> Aff Request
-fromHTTPRequest request = pure
-  { method: Method.read request
-  , path: Path.read request
-  , query: Query.read request
-  , headers: Headers.read request
-  , body: Body.read request
-  , httpVersion: Version.read request
-  , url: requestURL request
-  }
+fromHTTPRequest request = do
+  body <- liftEffect $ Body.read request
+  pure
+    { method: Method.read request
+    , path: Path.read request
+    , query: Query.read request
+    , headers: Headers.read request
+    , body
+    , httpVersion: Version.read request
+    , url: requestURL request
+    }
+

test/Test/HTTPure/BodySpec.purs

@@ -1,39 +1,69 @@
 module Test.HTTPure.BodySpec where
 
 import Prelude
+
 import Data.Maybe (Maybe(Nothing), fromMaybe)
+import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
-import Node.Buffer (toString) as Buffer
+import Effect.Ref (new) as Ref
+import HTTPure.Body (RequestBody, defaultHeaders, read, toBuffer, toStream, toString, write)
+import HTTPure.Headers (header)
 import Node.Buffer (Buffer, fromString)
+import Node.Buffer (toString) as Buffer
 import Node.Encoding (Encoding(UTF8))
 import Node.Stream (readString)
-import Test.Spec (describe, it)
-import HTTPure.Body (read, toString, toBuffer, defaultHeaders, write)
-import HTTPure.Headers (header)
 import Test.HTTPure.TestHelpers (Test, (?=), mockRequest, mockResponse, getResponseBody, stringToStream)
+import Test.Spec (describe, it)
+
+mockRequestBody :: String -> Aff RequestBody
+mockRequestBody body =
+  liftEffect do
+    buffer <- Ref.new Nothing
+    string <- Ref.new Nothing
+    pure
+      { buffer
+      , stream: stringToStream body
+      , string
+      }
 
 readSpec :: Test
 readSpec =
   describe "read" do
     it "is the body of the Request" do
-      body <- read <$> mockRequest "" "GET" "" "test" []
-      string <- liftEffect $ fromMaybe "" <$> readString body Nothing UTF8
+      body <- (liftEffect <<< read) =<< mockRequest "" "GET" "" "test" []
+      string <- liftEffect $ fromMaybe "" <$> readString (toStream body) Nothing UTF8
       string ?= "test"
 
 toStringSpec :: Test
 toStringSpec =
   describe "toString" do
-    it "slurps Streams into Strings" do
-      string <- toString $ stringToStream "foobar"
+    it "turns RequestBody into a String" do
+      requestBody <- mockRequestBody "foobar"
+      string <- toString requestBody
       string ?= "foobar"
+    it "is idempotent" do
+      requestBody <- mockRequestBody "foobar"
+      string1 <- toString requestBody
+      string2 <- toString requestBody
+      string1 ?= string2
 
 toBufferSpec :: Test
 toBufferSpec =
   describe "toBuffer" do
-    it "slurps Streams into Buffers" do
-      buf <- toBuffer $ stringToStream "foobar"
+    it "turns RequestBody into a Buffer" do
+      requestBody <- mockRequestBody "foobar"
+      buf <- toBuffer requestBody
       string <- liftEffect $ Buffer.toString UTF8 buf
       string ?= "foobar"
+    it "is idempotent" do
+      requestBody <- mockRequestBody "foobar"
+      buffer1 <- toBuffer requestBody
+      buffer2 <- toBuffer requestBody
+      string1 <- bufferToString buffer1
+      string2 <- bufferToString buffer2
+      string1 ?= string2
+  where
+  bufferToString = liftEffect <<< Buffer.toString UTF8
 
 defaultHeadersSpec :: Test
 defaultHeadersSpec =