diff --git a/http-client.carp b/http-client.carp index ef29308..08412eb 100644 --- a/http-client.carp +++ b/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)))) diff --git a/src/multipart.carp b/src/multipart.carp new file mode 100644 index 0000000..8f7ec3a --- /dev/null +++ b/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)))) diff --git a/test/http-client.carp b/test/http-client.carp index 170ae7f..d40c3aa 100644 --- a/test/http-client.carp +++ b/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"))