Use StringBuf for loop accumulation; extract body-request helper

bench/string-accumulate.carp

@@ -0,0 +1,111 @@
+(load "Bench.carp")
+(load "git@github.com:carpentry-org/strbuf@0.1.0")
+
+; Build an array of n string chunks of the given size.
+(defn make-chunks [n size]
+  (let-do [chunks []]
+    (for [i 0 n]
+      (set! chunks (Array.push-back chunks (String.allocate size \x))))
+    chunks))
+
+; Build header chunks: same as make-chunks but the last chunk ends
+; with \r\n\r\n (the HTTP header boundary that read-headers scans for).
+(defn make-header-chunks [n size]
+  (let-do [chunks []]
+    (for [i 0 (- n 1)]
+      (set! chunks (Array.push-back chunks (String.allocate size \h))))
+    (set! chunks
+          (Array.push-back chunks
+                           (String.concat
+                             &[(String.allocate (- size 4) \h) @"\r\n\r\n"])))
+    chunks))
+
+; ----------------------------------------------------------------
+; read-headers accumulation pattern
+;
+; Client.read-headers reads from a Connection in a loop, accumulating
+; data until the \r\n\r\n header boundary is found. These functions
+; simulate that loop with pre-built chunks.
+; ----------------------------------------------------------------
+
+; Before this PR: String.concat in a loop (quadratic)
+(defn read-headers-concat [chunks]
+  (let-do [acc @""
+           found false
+           i 0]
+    (while-do (and (not found) (< i (Array.length chunks)))
+      (set! acc (String.concat &[acc @(Array.unsafe-nth chunks i)]))
+      (when (String.contains-string? &acc "\r\n\r\n") (set! found true))
+      (set! i (+ i 1)))
+    (ignore acc)))
+
+; After this PR: StringBuf with non-destructive peek (linear growth)
+(defn read-headers-strbuf [chunks]
+  (let-do [sb (StringBuf.create)
+           found false
+           i 0]
+    (while-do (and (not found) (< i (Array.length chunks)))
+      (StringBuf.append-str &sb (Array.unsafe-nth chunks i))
+      (let [acc (StringBuf.str &sb)]
+        (when (String.contains-string? &acc "\r\n\r\n") (set! found true)))
+      (set! i (+ i 1)))
+    (StringBuf.delete sb)))
+
+; ----------------------------------------------------------------
+; drain-stream accumulation pattern
+;
+; Client.drain-stream reads all chunks from a ResponseStream and
+; concatenates them into the final response body. This is where the
+; quadratic-to-linear improvement is most significant.
+; ----------------------------------------------------------------
+
+; Before this PR: String.concat in a loop (quadratic)
+(defn drain-concat [chunks]
+  (let-do [acc @""]
+    (for [i 0 (Array.length chunks)]
+      (set! acc (String.concat &[acc @(Array.unsafe-nth chunks i)])))
+    (ignore acc)))
+
+; After this PR: StringBuf accumulation (linear)
+(defn drain-strbuf [chunks]
+  (let-do [sb (StringBuf.create)]
+    (for [i 0 (Array.length chunks)]
+      (StringBuf.append-str &sb (Array.unsafe-nth chunks i)))
+    (StringBuf.delete sb)))
+
+; ----------------------------------------------------------------
+
+(defn main []
+  (do
+    (println* "")
+    (println* "http-client StringBuf optimization benchmark")
+    (println* "=============================================")
+    (println* "Simulates the accumulation loops in Client.read-headers and")
+    (println* "Client.drain-stream with realistic HTTP payload sizes.")
+    (println* "Chunk size: 4KB (typical TCP socket read).")
+    (println* "")
+    (println* "--- read-headers: 16KB headers, 4 chunks ---")
+    (println* "  concat (before):")
+    (let [d (make-header-chunks 4 4096)]
+      (Bench.bench (fn [] (read-headers-concat &d))))
+    (println* "  StringBuf (after):")
+    (let [d (make-header-chunks 4 4096)]
+      (Bench.bench (fn [] (read-headers-strbuf &d))))
+    (println* "")
+    (println* "--- drain-stream: 16KB body, 4 chunks ---")
+    (println* "  concat (before):")
+    (let [d (make-chunks 4 4096)] (Bench.bench (fn [] (drain-concat &d))))
+    (println* "  StringBuf (after):")
+    (let [d (make-chunks 4 4096)] (Bench.bench (fn [] (drain-strbuf &d))))
+    (println* "")
+    (println* "--- drain-stream: 64KB body, 16 chunks ---")
+    (println* "  concat (before):")
+    (let [d (make-chunks 16 4096)] (Bench.bench (fn [] (drain-concat &d))))
+    (println* "  StringBuf (after):")
+    (let [d (make-chunks 16 4096)] (Bench.bench (fn [] (drain-strbuf &d))))
+    (println* "")
+    (println* "--- drain-stream: 256KB body, 64 chunks ---")
+    (println* "  concat (before):")
+    (let [d (make-chunks 64 4096)] (Bench.bench (fn [] (drain-concat &d))))
+    (println* "  StringBuf (after):")
+    (let [d (make-chunks 64 4096)] (Bench.bench (fn [] (drain-strbuf &d))))))

http-client.carp

@@ -1,6 +1,7 @@
 (load "git@github.com:carpentry-org/socket@0.1.4")
 (load "git@github.com:carpentry-org/http@0.1.4")
 (load "git@github.com:carpentry-org/tls@0.1.0")
+(load "git@github.com:carpentry-org/strbuf@0.1.0")
 
 (relative-include "src/chunked.h")
 
@@ -101,9 +102,13 @@ from the streams library.
   (private poll-chunked)
   (defn poll-chunked [s]
     ; try to decode from existing buffer first, reading more if needed
-    (let-do [result (Maybe.Nothing)]
-      (while (Maybe.nothing? &result)
-        (let [raw (String.concat &[@(buf s) @(decoded s)])]
+    (let-do [result (Maybe.Nothing)
+             sb (StringBuf.create)]
+      (while-do (Maybe.nothing? &result)
+        (StringBuf.clear &sb)
+        (StringBuf.append-str &sb (buf s))
+        (StringBuf.append-str &sb (decoded s))
+        (let [raw (StringBuf.to-string &sb)]
           (let-do [out @""
                    consumed 0
                    rc (chunked-decode-one- (String.cstr &raw)
@@ -125,8 +130,13 @@ from the streams library.
                 (Result.Success chunk)
                   (if (= (String.length &chunk) 0)
                     (do (set-done! s true) (break))
-                    (set-buf! s (String.concat &[@(buf s) chunk])))
+                    (do
+                      (StringBuf.clear &sb)
+                      (StringBuf.append-str &sb (buf s))
+                      (StringBuf.append-str &sb &chunk)
+                      (set-buf! s (StringBuf.to-string &sb))))
                 (Result.Error _) (do (set-done! s true) (break)))))))
+      (StringBuf.delete sb)
       result))
 
   (doc poll "returns the next chunk of decoded body data, or `Nothing` when
@@ -224,27 +234,31 @@ the response is complete.")
   (doc read-headers "reads from a connection until HTTP headers are complete.
 Returns the raw header text and any leftover body data.")
   (defn read-headers [conn]
-    (let-do [acc @""
+    (let-do [sb (StringBuf.create)
              found false]
       (while (not found)
         (match (Connection.read conn)
           (Result.Success chunk)
             (if (= (String.length &chunk) 0)
               (set! found true)
               (do
-                (set! acc (String.concat &[acc chunk]))
-                (when (String.contains-string? &acc "\r\n\r\n")
-                  (set! found true))))
+                (StringBuf.append-str &sb &chunk)
+                (let [acc (StringBuf.str &sb)]
+                  (when (String.contains-string? &acc "\r\n\r\n")
+                    (set! found true)))))
           (Result.Error _) (set! found true)))
-      (let [split-pos (String.index-of-string &acc "\r\n\r\n")]
-        (if (< split-pos 0)
-          (Result.Error @"incomplete HTTP headers")
-          (let [header-end (+ split-pos 4)
-                header-text (String.prefix &acc header-end)
-                body-start (String.suffix &acc header-end)]
-            (match (Response.parse &header-text)
-              (Result.Error e) (Result.Error e)
-              (Result.Success resp) (Result.Success (Pair.init resp body-start))))))))
+      (let-do [acc (StringBuf.to-string &sb)]
+        (StringBuf.delete sb)
+        (let [split-pos (String.index-of-string &acc "\r\n\r\n")]
+          (if (< split-pos 0)
+            (Result.Error @"incomplete HTTP headers")
+            (let [header-end (+ split-pos 4)
+                  header-text (String.prefix &acc header-end)
+                  body-start (String.suffix &acc header-end)]
+              (match (Response.parse &header-text)
+                (Result.Error e) (Result.Error e)
+                (Result.Success resp)
+                  (Result.Success (Pair.init resp body-start)))))))))
 
   (doc request-stream "sends an HTTP request and returns a `ResponseStream` for
 reading the response body incrementally. Use `ResponseStream.poll` to read chunks.
@@ -276,13 +290,13 @@ to verify the request succeeded before polling.")
   (hidden drain-stream)
   (private drain-stream)
   (defn drain-stream [s]
-    (let-do [body @""
+    (let-do [sb (StringBuf.create)
              done false]
       (while (not done)
         (match (ResponseStream.poll s)
           (Maybe.Nothing) (set! done true)
-          (Maybe.Just chunk) (set! body (String.concat &[body chunk]))))
-      body))
+          (Maybe.Just chunk) (StringBuf.append-str &sb &chunk)))
+      (let-do [body (StringBuf.to-string &sb)] (StringBuf.delete sb) body)))
 
   (doc request
     "sends an HTTP request to the given URL. Returns `(Result Response String)`.
@@ -301,27 +315,25 @@ handling chunked transfer-encoding.")
   (doc get "performs an HTTP GET request. Returns `(Result Response String)`.")
   (defn get [url] (request "GET" url (the (Map String (Array String)) {}) ""))
 
-  (doc post "performs an HTTP POST request with headers and body.
-Returns `(Result Response String)`.")
-  (defn post [url headers body]
+  (hidden body-request)
+  (private body-request)
+  (defn body-request [verb url headers body]
     (let [cl-vals [(Int.str (String.length body))]
           hdrs (Map.put headers &@"Content-Length" &cl-vals)]
-      (request "POST" url hdrs body)))
+      (request verb url hdrs body)))
+
+  (doc post "performs an HTTP POST request with headers and body.
+Returns `(Result Response String)`.")
+  (defn post [url headers body] (body-request "POST" url headers body))
 
   (doc put "performs an HTTP PUT request with headers and body.
 Returns `(Result Response String)`.")
-  (defn put [url headers body]
-    (let [cl-vals [(Int.str (String.length body))]
-          hdrs (Map.put headers &@"Content-Length" &cl-vals)]
-      (request "PUT" url hdrs body)))
+  (defn put [url headers body] (body-request "PUT" url headers body))
 
   (doc del
     "performs an HTTP DELETE request. Returns `(Result Response String)`.")
   (defn del [url] (request "DELETE" url (the (Map String (Array String)) {}) ""))
 
   (doc patch "performs an HTTP PATCH request with headers and body.
 Returns `(Result Response String)`.")
-  (defn patch [url headers body]
-    (let [cl-vals [(Int.str (String.length body))]
-          hdrs (Map.put headers &@"Content-Length" &cl-vals)]
-      (request "PATCH" url hdrs body))))
+  (defn patch [url headers body] (body-request "PATCH" url headers body)))