Multipart uploads (#16)

.dir-locals.el

@@ -0,0 +1,2 @@
+((clojure-mode
+  (cider-clojure-cli-aliases . ":repl")))

.gitignore

@@ -1,3 +1,4 @@
 .cache
 .cpcache
 target
+.nrepl-port

README.md

@@ -216,6 +216,25 @@ To opt out of an exception being thrown, set `:throw` to false.
 ;;=> 404
 ```
 
+### Multipart
+
+To perform a multipart request, supply `:multipart` with a sequence of maps with the following options:
+
+- `:name`: The name of the param
+- `:part-name`: Override for `:name`
+- `:content`: The part's data. May be string or something that can be fed into `clojure.java.io/input-stream`
+- `:file-name`: The part's file name. If the `:content` is a file, the name of the file will be used, unless `:file-name` is set.
+- `:content-type`: The part's content type. By default, if `:content` is a string it will be `text/plain; charset=UTF-8`; if `:content` is a file it will attempt to guess the best content type or fallback to `application/octet-stream`.
+
+An example request:
+
+``` clojure
+(http/post "https://postman-echo.com/post"
+           {:multipart [{:name "title" :content "My Title"}
+                        {:name "Content/type" :content "image/jpeg"}
+                        {:name "file" :content (io/file "foo.jpg") :file-name "foobar.jpg"}]})
+```
+
 ### Compression
 
 To accept gzipped or zipped responses, use:

deps.edn

@@ -2,14 +2,14 @@
  :aliases
  {:neil {:project {:name org.babashka/http-client
                    :version "0.0.3"}}
+  :repl {:extra-deps {cheshire/cheshire {:mvn/version "5.11.0"}}}
   :test ;; added by neil
   {:extra-paths ["test"]
-   :extra-deps {io.github.cognitect-labs/test-runner
-                {:git/tag "v0.5.0" :git/sha "b3fd0d2"}
-                cheshire/cheshire {:mvn/version "5.11.0"}}
+   :extra-deps {cheshire/cheshire {:mvn/version "5.11.0"}
+                io.github.cognitect-labs/test-runner
+                {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
    :main-opts ["-m" "cognitect.test-runner"]
    :exec-fn cognitect.test-runner.api/test}
-
   :build ;; added by neil
   {:deps {io.github.clojure/tools.build {:git/tag "v0.9.0" :git/sha "8c93e0c"}
           slipset/deps-deploy {:mvn/version "0.2.0"}}

src/babashka/http_client/interceptors.clj

@@ -2,7 +2,8 @@
   (:refer-clojure :exclude [send get])
   (:require
    [clojure.java.io :as io]
-   [clojure.string :as str])
+   [clojure.string :as str]
+   [babashka.http-client.internal.multipart :as multipart])
   (:import
    [java.net URLEncoder]
    [java.util Base64]
@@ -200,6 +201,18 @@
                    resp
                    (throw (ex-info (str "Exceptional status code: " status) resp)))))})
 
+(def multipart
+  "Adds appropriate body and header if making a multipart request."
+  {:name ::multipart
+   :request (fn [{:keys [multipart] :as req}]
+              (if multipart
+                (let [b (multipart/boundary)]
+                  (-> req
+                      (dissoc :multipart)
+                      (assoc :body (multipart/body multipart b))
+                      (update :headers assoc "content-type" (str "multipart/form-data; boundary=" b))))
+                req))})
+
 (def default-interceptors
   "Default interceptor chain. Interceptors are called in order for request and in reverse order for response."
   [throw-on-exceptional-status-code
@@ -208,6 +221,7 @@
    basic-auth
    query-params
    form-params
+   multipart
    decode-body
    decompress-body])
 

src/babashka/http_client/internal/multipart.clj

@@ -0,0 +1,90 @@
+(ns babashka.http-client.internal.multipart
+  "Multipart implementation largely inspired by hato"
+  (:refer-clojure :exclude [get])
+  (:require [clojure.java.io :as io])
+  (:import [java.io InputStream File]
+           [java.nio.file Files]))
+
+(set! *warn-on-reflection* true)
+
+;;; Helpers
+
+(defn- content-disposition
+  [{:keys [part-name name content file-name]}]
+  (str "Content-Disposition: form-data; "
+       (format "name=\"%s\"" (or part-name name))
+       (when-let [fname (or file-name
+                            (when (instance? File content)
+                              (.getName ^File content)))]
+         (format "; filename=\"%s\"" fname))))
+
+(defn- content-type
+  [{:keys [content content-type]}]
+  (str "Content-Type: "
+       (cond
+         content-type content-type
+         (string? content) "text/plain; charset=UTF-8"
+         (instance? File content) (or (Files/probeContentType (.toPath ^File content))
+                                      "application/octet-stream")
+         :else "application/octet-stream")))
+
+(defn- content-transfer-encoding
+  [{:keys [content]}]
+  (if (string? content)
+    "Content-Transfer-Encoding: 8bit"
+    "Content-Transfer-Encoding: binary"))
+
+(def crlf "\r\n")
+
+(defn boundary
+  "Creates a boundary string compliant with RFC2046
+
+  See https://www.ietf.org/rfc/rfc2046.txt"
+  []
+  (str "babashka_http_client_Boundary" (random-uuid)))
+
+(defn concat-streams [^InputStream is1 ^InputStream is2 & more]
+  (let [is (new java.io.SequenceInputStream is1 is2)]
+    (if more
+      (recur is (first more) (next more))
+      is)))
+
+(defn ->input-stream [x]
+  (if (string? x)
+    (java.io.ByteArrayInputStream. (.getBytes ^String x))
+    (io/input-stream x)))
+
+(defn body
+  "Returns an InputStream from the multipart input."
+  [ms b]
+  (let [streams
+        (mapcat (fn [m]
+                  (map ->input-stream
+                       [(str "--" b)
+                        crlf
+                        (content-disposition m)
+                        crlf
+                        (content-type m)
+                        crlf
+                        (content-transfer-encoding m)
+                        crlf
+                        crlf
+                        (:content m)
+                        crlf]))
+                ms)
+        concat-stream (apply concat-streams
+                             (concat streams
+                                     [(->input-stream (str "--" b "--"))
+                                      (->input-stream crlf)]))]
+    concat-stream))
+
+(comment
+  (def b (boundary))
+  (def ms [{:name "title" :content "My Awesome Picture"}
+           {:name "Content/type" :content "image/jpeg"}
+           {:name "foo.txt" :part-name "eggplant" :content "Eggplants"}
+           {:name "file" :content (io/file ".nrepl-port")}])
+  (with-open [xin (io/input-stream (body ms b))
+              xout (java.io.ByteArrayOutputStream.)]
+    (io/copy xin xout)
+    (String. (.toByteArray xout))))

test/babashka/http_client_test.clj

@@ -22,7 +22,7 @@
                      "200"))
   (is (= 200
          (-> (http/get "https://httpstat.us/200"
-                         {:headers {"Accept" "application/json"}})
+                       {:headers {"Accept" "application/json"}})
              :body
              (json/parse-string true)
              :code)))
@@ -52,31 +52,31 @@
             0 10))
   (is (str/includes?
        (:body (http/post "https://postman-echo.com/post"
-                           {:body "From Clojure"}))
+                         {:body "From Clojure"}))
        "From Clojure"))
   (testing "file body"
     (is (str/includes?
          (:body (http/post "https://postman-echo.com/post"
-                             {:body (io/file "README.md")}))
+                           {:body (io/file "README.md")}))
          "babashka")))
   (testing "JSON body"
     (let [response (http/post "https://postman-echo.com/post"
-                                {:headers {"Content-Type" "application/json"}
-                                 :body (json/generate-string {:a "foo"})})
+                              {:headers {"Content-Type" "application/json"}
+                               :body (json/generate-string {:a "foo"})})
           body (:body response)
           body (json/parse-string body true)
           json (:json body)]
       (is (= {:a "foo"} json))))
   (testing "stream body"
     (is (str/includes?
          (:body (http/post "https://postman-echo.com/post"
-                             {:body (io/input-stream "README.md")}))
+                           {:body (io/input-stream "README.md")}))
          "babashka")))
   (testing "form-params"
     (let [body (:body (http/post "https://postman-echo.com/post"
-                                   {:form-params {"name" "Michiel Borkent"
-                                                  :location "NL"
-                                                  :this-isnt-a-string 42}}))
+                                 {:form-params {"name" "Michiel Borkent"
+                                                :location "NL"
+                                                :this-isnt-a-string 42}}))
           body (json/parse-string body true)
           headers (:headers body)
           content-type (:content-type headers)]
@@ -103,14 +103,14 @@
 (deftest patch-test
   (is (str/includes?
        (:body (http/patch "https://postman-echo.com/patch"
-                            {:body "hello"}))
+                          {:body "hello"}))
        "hello")))
 
 (deftest basic-auth-test
   (is (re-find #"authenticated.*true"
                (:body
                 (http/get "https://postman-echo.com/basic-auth"
-                            {:basic-auth ["postman" "password"]})))))
+                          {:basic-auth ["postman" "password"]})))))
 
 (deftest get-response-object-test
   (let [response (http/get "https://httpstat.us/200")]
@@ -134,7 +134,7 @@
   (testing "response object without fully following redirects"
     ;; (System/getProperty "jdk.httpclient.redirects.retrylimit" "0")
     (let [response (http/get "https://httpbin.org/redirect-to?url=https://www.httpbin.org"
-                               {:client (http/client {:follow-redirects :never})})]
+                             {:client (http/client {:follow-redirects :never})})]
       (is (map? response))
       (is (= 302 (:status response)))
       (is (= "" (:body response)))
@@ -144,7 +144,7 @@
 (deftest accept-header-test
   (is (= 200
          (-> (http/get "https://httpstat.us/200"
-                         {:accept :json})
+                       {:accept :json})
              :body
              (json/parse-string true)
              :code))))
@@ -203,8 +203,8 @@
   (let [server (java.net.ServerSocket. 1668)
         port (.getLocalPort server)]
     (future (try (with-open
-                   [socket (.accept server)
-                    out (io/writer (.getOutputStream socket))]
+                  [socket (.accept server)
+                   out (io/writer (.getOutputStream socket))]
                    (binding [*out* out]
                      (println "HTTP/1.1 200 OK")
                      (println "Content-Type: text/event-stream")
@@ -228,23 +228,23 @@
       (is (= (repeat 10 "data: Stream Hello!") (take 10 (line-seq (io/reader body))))))))
 
 (deftest exceptional-status-test
-    (testing "should throw"
-      (let [ex (is (thrown? ExceptionInfo (http/get "https://httpstat.us/404")))
-            response (ex-data ex)]
-        (is (= 404 (:status response)))))
-    (testing "should throw when streaming based on status code"
-      (let [ex (is (thrown? ExceptionInfo (http/get "https://httpstat.us/404" {:throw true
-                                                                                 :as :stream})))
-            response (ex-data ex)]
-        (is (= 404 (:status response)))
-        (is (= "404 Not Found" (slurp (:body response))))))
-    (testing "should not throw"
-      (let [response (http/get "https://httpstat.us/404" {:throw false})]
-        (is (= 404 (:status response))))))
+  (testing "should throw"
+    (let [ex (is (thrown? ExceptionInfo (http/get "https://httpstat.us/404")))
+          response (ex-data ex)]
+      (is (= 404 (:status response)))))
+  (testing "should throw when streaming based on status code"
+    (let [ex (is (thrown? ExceptionInfo (http/get "https://httpstat.us/404" {:throw true
+                                                                             :as :stream})))
+          response (ex-data ex)]
+      (is (= 404 (:status response)))
+      (is (= "404 Not Found" (slurp (:body response))))))
+  (testing "should not throw"
+    (let [response (http/get "https://httpstat.us/404" {:throw false})]
+      (is (= 404 (:status response))))))
 
 (deftest compressed-test
   (let [resp (http/get "https://api.stackexchange.com/2.2/sites"
-                         {:headers {"Accept-Encoding" ["gzip" "deflate"]}})]
+                       {:headers {"Accept-Encoding" ["gzip" "deflate"]}})]
     (is (-> resp :body (json/parse-string true) :items))))
 
 (deftest default-client-test
@@ -268,7 +268,7 @@
 (deftest header-with-keyword-key-test
   (is (= 200
          (-> (http/get "https://httpstat.us/200"
-                         {:headers {:accept "application/json"}})
+                       {:headers {:accept "application/json"}})
              :body
              (json/parse-string true)
              :code))))
@@ -300,11 +300,26 @@
         ;; Add json interceptor add beginning of chain
         ;; It will be the first to see the request and the last to see the response
         interceptors (cons json-interceptor interceptors/default-interceptors)]
-
     (testing "interceptors on request"
       (let [resp (http/get "https://httpstat.us/200"
-                             {:interceptors interceptors
-                              :as :json})]
+                           {:interceptors interceptors
+                            :as :json})]
         (is (= 200 (-> resp :body
                        ;; response as JSON
                        :code)))))))
+
+(deftest multipart-test
+  (let [uuid (.toString (random-uuid))
+        _ (spit (doto (io/file ".test-data")
+                  (.deleteOnExit)) uuid)
+        resp (http/post "https://postman-echo.com/post"
+                        {:multipart [{:name "title" :content "My Awesome Picture"}
+                                     {:name "Content/type" :content "image/jpeg"}
+                                     {:name "foo.txt" :part-name "eggplant" :content "Eggplants"}
+                                     {:name "file" :content (io/file ".test-data") :file-name "dude"}]})
+        resp-body (:body resp)
+        resp-body (json/parse-string resp-body true)
+        headers (:headers resp-body)]
+    (is (str/starts-with? (:content-type headers) "multipart/form-data; boundary=babashka_http_client_Boundary"))
+    (is (some? (:dude (:files resp-body))))
+    (is (= "My Awesome Picture" (-> resp-body :form :title)))))