Add multipart/form-data request body encoding

http-client.carp

@@ -3,6 +3,8 @@
 (load "git@github.com:carpentry-org/tls@0.1.0")
 (load "git@github.com:carpentry-org/strbuf@0.1.0")
 
+(load "src/multipart.carp")
+
 (relative-include "src/chunked.h")
 
 ; The `poll` interface for pull-based streams. Inlined here so that
@@ -174,9 +176,7 @@ from the streams library.
   (doc poll "returns the next chunk of decoded body data, or `Nothing` when
 the response is complete.")
   (defn poll [s]
-    (if @(done s)
-      (Maybe.Nothing)
-      (if @(chunked s) (poll-chunked s) (poll-raw s))))
+    (cond @(done s) (Maybe.Nothing) @(chunked s) (poll-chunked s) (poll-raw s)))
   (implements poll ResponseStream.poll)
 
   (doc close "closes the underlying connection.")
@@ -322,9 +322,9 @@ to follow. Used by `request`, `request-stream`, and convenience methods.")
   (hidden resolve-location)
   (private resolve-location)
   (defn resolve-location [base-url location]
-    (if (String.contains-string? location "://")
-      @location
-      (if (String.starts-with? location "/")
+    (cond
+      (String.contains-string? location "://") @location
+      (String.starts-with? location "/")
         (match (URI.parse base-url)
           (Result.Error _) @location
           (Result.Success base-uri)
@@ -336,7 +336,7 @@ to follow. Used by `request`, `request-stream`, and convenience methods.")
                       (if (= p (default-port &scheme)) @"" (fmt ":%d" p))
                     (Maybe.Nothing) @"")]
               (String.concat &[scheme @"://" host port-str @location])))
-        @location)))
+      @location))
 
   (hidden remove-content-length)
   (private remove-content-length)
@@ -640,4 +640,46 @@ See `RequestConfig` for timeout and redirect details.")
 Returns `(Result Response String)`.
 See `RequestConfig` for timeout and redirect details.")
   (defn patch-with-config [url headers body config]
-    (body-request-with-config "PATCH" url headers body config)))
+    (body-request-with-config "PATCH" url headers body config))
+
+  ; =========================================================================
+  ; Multipart form-data convenience wrappers
+  ; =========================================================================
+
+  (doc post-multipart "performs an HTTP POST request with a multipart/form-data
+body. Generates a boundary, encodes the parts, and sets the Content-Type
+header automatically. Any Content-Type header in `headers` is overwritten.
+Returns `(Result Response String)`.
+
+```
+(Client.post-multipart \"https://example.com/upload\"
+  {}
+  &[(Multipart.text-part \"field\" \"value\")
+    (Multipart.file-part \"upload\" \"test.txt\"
+                         \"text/plain\" \"file contents\")])
+```")
+  (defn post-multipart [url headers parts]
+    (let [boundary (Multipart.generate-boundary)
+          body (Multipart.encode parts &boundary)
+          ct-vals [(Multipart.content-type-header &boundary)]
+          cl-vals [(Int.str (String.length &body))]
+          hdrs (Map.put
+            (Map.put headers &@"Content-Type" &ct-vals)
+            &@"Content-Length"
+            &cl-vals)]
+      (request "POST" url hdrs &body)))
+
+  (doc post-multipart-with-config "performs an HTTP POST request with a
+multipart/form-data body using the given `RequestConfig`.
+Returns `(Result Response String)`.
+See `RequestConfig` for timeout and redirect details.")
+  (defn post-multipart-with-config [url headers parts config]
+    (let [boundary (Multipart.generate-boundary)
+          body (Multipart.encode parts &boundary)
+          ct-vals [(Multipart.content-type-header &boundary)]
+          cl-vals [(Int.str (String.length &body))]
+          hdrs (Map.put
+            (Map.put headers &@"Content-Type" &ct-vals)
+            &@"Content-Length"
+            &cl-vals)]
+      (request-with-config "POST" url hdrs &body config))))

src/multipart.carp

@@ -0,0 +1,93 @@
+(doc Part "represents a single part in a multipart/form-data body.
+Use `Multipart.text-part` to create a simple text field, or
+`Multipart.file-part` to create a file upload part.")
+(deftype Part
+  [name String
+   filename (Maybe String)
+   content-type (Maybe String)
+   body String])
+
+(doc Multipart "provides multipart/form-data encoding for HTTP requests
+(RFC 7578).
+
+## Encoding manually
+
+```
+(let [parts [(Multipart.text-part \"name\" \"Carp\")
+             (Multipart.file-part \"upload\" \"test.txt\"
+                                  \"text/plain\" \"file contents\")]
+      boundary (Multipart.generate-boundary)]
+  (Client.post url
+    {@\"Content-Type\" [(Multipart.content-type-header &boundary)]}
+    &(Multipart.encode &parts &boundary)))
+```
+
+## Convenience function
+
+```
+(Client.post-multipart url {}
+  &[(Multipart.text-part \"field\" \"value\")])
+```")
+(defmodule Multipart
+  (hidden escape-quotes)
+  (private escape-quotes)
+  (defn escape-quotes [s]
+    (let [q (Char.from-int 34)] (String.join "\\\"" &(String.split-by s &[q]))))
+
+  (doc text-part "creates a text form field part with the given name and value.")
+  (defn text-part [name value]
+    (Part.init @name (Maybe.Nothing) (Maybe.Nothing) @value))
+
+  (doc file-part "creates a file upload part with a filename and content type.
+The `data` parameter is the raw file contents as a string.")
+  (defn file-part [name filename content-type data]
+    (Part.init @name (Maybe.Just @filename) (Maybe.Just @content-type) @data))
+
+  (doc generate-boundary
+    "generates a boundary string for multipart encoding, using the current
+time for uniqueness.")
+  (defn generate-boundary []
+    (String.append "----CarpBoundary" &(Int.str (System.time))))
+
+  (doc content-type-header
+    "returns the Content-Type header value for multipart/form-data with the
+given boundary.")
+  (defn content-type-header [boundary]
+    (String.append "multipart/form-data; boundary=" boundary))
+
+  (doc encode
+    "encodes an array of parts into a multipart/form-data body string using
+the given boundary (RFC 7578).")
+  (defn encode [parts boundary]
+    (let-do [sb (StringBuf.create)]
+      (for [i 0 (Array.length parts)]
+        (let-do [part (Array.unsafe-nth parts i)]
+          (StringBuf.append-str &sb "--")
+          (StringBuf.append-str &sb boundary)
+          (StringBuf.append-crlf &sb)
+          (StringBuf.append-str &sb "Content-Disposition: form-data; name=\"")
+          (StringBuf.append-str &sb &(escape-quotes (Part.name part)))
+          (StringBuf.append-str &sb "\"")
+          (match-ref (Part.filename part)
+            (Maybe.Just fname)
+              (do
+                (StringBuf.append-str &sb "; filename=\"")
+                (StringBuf.append-str &sb &(escape-quotes fname))
+                (StringBuf.append-str &sb "\""))
+            (Maybe.Nothing) ())
+          (StringBuf.append-crlf &sb)
+          (match-ref (Part.content-type part)
+            (Maybe.Just ct)
+              (do
+                (StringBuf.append-str &sb "Content-Type: ")
+                (StringBuf.append-str &sb ct)
+                (StringBuf.append-crlf &sb))
+            (Maybe.Nothing) ())
+          (StringBuf.append-crlf &sb)
+          (StringBuf.append-str &sb (Part.body part))
+          (StringBuf.append-crlf &sb)))
+      (StringBuf.append-str &sb "--")
+      (StringBuf.append-str &sb boundary)
+      (StringBuf.append-str &sb "--")
+      (StringBuf.append-crlf &sb)
+      (let-do [result (StringBuf.to-string &sb)] (StringBuf.delete sb) result))))

test/http-client.carp

@@ -258,4 +258,139 @@
     (let [cfg (RequestConfig.init 0 2 10)]
       (Result.error?
         &(Client.get-with-config "https://httpbin.org/delay/10" &cfg)))
-    "read-timeout causes error on slow response"))
+    "read-timeout causes error on slow response")
+
+  ; =========================================================================
+  ; Multipart encoding
+  ; =========================================================================
+
+  ; text-part creates a Part with no filename or content-type
+  (assert-equal test
+    &@"field"
+    (Part.name &(Multipart.text-part "field" "value"))
+    "text-part sets name")
+
+  (assert-equal test
+    &@"value"
+    (Part.body &(Multipart.text-part "field" "value"))
+    "text-part sets body")
+
+  (assert-true test
+    (Maybe.nothing? (Part.filename &(Multipart.text-part "field" "value")))
+    "text-part has no filename")
+
+  (assert-true test
+    (Maybe.nothing? (Part.content-type &(Multipart.text-part "field" "value")))
+    "text-part has no content-type")
+
+  ; file-part creates a Part with filename and content-type
+  (assert-equal test
+    &@"upload"
+    (Part.name &(Multipart.file-part "upload" "test.txt" "text/plain" "data"))
+    "file-part sets name")
+
+  (assert-equal test
+    &(Maybe.Just @"test.txt")
+    (Part.filename
+      &(Multipart.file-part "upload" "test.txt" "text/plain" "data"))
+    "file-part sets filename")
+
+  (assert-equal test
+    &(Maybe.Just @"text/plain")
+    (Part.content-type
+      &(Multipart.file-part "upload" "test.txt" "text/plain" "data"))
+    "file-part sets content-type")
+
+  ; content-type-header produces correct value
+  (assert-equal test
+    &@"multipart/form-data; boundary=myboundary"
+    &(Multipart.content-type-header "myboundary")
+    "content-type-header formats correctly")
+
+  ; generate-boundary returns a non-empty string
+  (assert-true test
+    (> (String.length &(Multipart.generate-boundary)) 0)
+    "generate-boundary returns non-empty string")
+
+  (assert-true test
+    (String.starts-with? &(Multipart.generate-boundary) "----CarpBoundary")
+    "generate-boundary starts with expected prefix")
+
+  ; encode single text part
+  (assert-equal test
+    &@"--b\r\nContent-Disposition: form-data; name=\"field\"\r\n\r\nvalue\r\n--b--\r\n"
+    &(Multipart.encode &[(Multipart.text-part "field" "value")] "b")
+    "encode single text part")
+
+  ; encode single file part
+  (assert-equal test
+    &@"--b\r\nContent-Disposition: form-data; name=\"f\"; filename=\"test.txt\"\r\nContent-Type: text/plain\r\n\r\ndata\r\n--b--\r\n"
+    &(Multipart.encode
+      &[(Multipart.file-part "f" "test.txt" "text/plain" "data")]
+      "b")
+    "encode single file part")
+
+  ; encode multiple parts
+  (assert-equal test
+    &@"--b\r\nContent-Disposition: form-data; name=\"name\"\r\n\r\nCarp\r\n--b\r\nContent-Disposition: form-data; name=\"f\"; filename=\"x.bin\"\r\nContent-Type: application/octet-stream\r\n\r\nBIN\r\n--b--\r\n"
+    &(Multipart.encode
+      &[(Multipart.text-part "name" "Carp")
+        (Multipart.file-part "f" "x.bin" "application/octet-stream" "BIN")]
+      "b")
+    "encode mixed text and file parts")
+
+  ; encode empty parts array
+  (assert-equal test
+    &@"--b--\r\n"
+    &(Multipart.encode &(the (Array Part) []) "b")
+    "encode empty parts produces closing boundary only")
+
+  ; encode escapes quotes in name and filename
+  (assert-equal test
+    &@"--b\r\nContent-Disposition: form-data; name=\"a\\\"b\"; filename=\"c\\\"d\"\r\nContent-Type: text/plain\r\n\r\ndata\r\n--b--\r\n"
+    &(Multipart.encode
+      &[(Multipart.file-part "a\"b" "c\"d" "text/plain" "data")]
+      "b")
+    "encode escapes quotes in name and filename")
+
+  ; =========================================================================
+  ; POST multipart (integration)
+  ; =========================================================================
+
+  (assert-true test
+    (Result.success?
+      &(Client.post-multipart "https://httpbin.org/post"
+                              (the (Map String (Array String)) {})
+                              &[(Multipart.text-part "greeting"
+                                                     "hello from carp")]))
+    "post-multipart to httpbin.org succeeds")
+
+  (assert-true test
+    (match (Client.post-multipart "https://httpbin.org/post"
+                                  (the (Map String (Array String)) {})
+                                  &[(Multipart.text-part "greeting" "hello")])
+      (Result.Success r) (Response.ok? &r)
+      _ false)
+    "post-multipart returns 200")
+
+  (assert-true test
+    (match (Client.post-multipart "https://httpbin.org/post"
+                                  (the (Map String (Array String)) {})
+                                  &[(Multipart.text-part "greeting"
+                                                         "hello from carp")])
+      (Result.Success r)
+        (String.contains-string? (Response.body &r) "hello from carp")
+      _ false)
+    "post-multipart body is echoed back by httpbin")
+
+  (assert-true test
+    (match (Client.post-multipart "https://httpbin.org/post"
+                                  (the (Map String (Array String)) {})
+                                  &[(Multipart.file-part "upload"
+                                                         "test.txt"
+                                                         "text/plain"
+                                                         "file contents")])
+      (Result.Success r)
+        (String.contains-string? (Response.body &r) "file contents")
+      _ false)
+    "post-multipart file part is echoed back by httpbin"))