Add Transit JSON/MessagePack support

README.org

@@ -149,6 +149,16 @@ More example requests:
                                :content-type :json
                                :json-opts {:date-format "yyyy-MM-dd"})
 
+;; Send form params as a Transit encoded JSON body (POST or PUT) with options
+(client/post "http://site.com" {:form-params {:foo "bar"}
+                                :content-type :transit+json
+                                :transit-opts {:handlers {}}})
+
+;; Send form params as a Transit encoded MessagePack body (POST or PUT) with options
+(client/post "http://site.com" {:form-params {:foo "bar"}
+                                :content-type :transit+msgpack
+                                :transit-opts {:handlers {}}})
+
 ;; Multipart form uploads/posts
 ;; takes a vector of maps, to preserve the order of entities, :name
 ;; will be used as the part name unless :part-name is specified
@@ -247,6 +257,10 @@ content encodings.
 (client/get "http://site.com/foo.json" {:as :json-string-keys})
 (client/get "http://site.com/foo.json" {:as :json-strict-string-keys})
 
+;; Coerce as Transit encoded JSON or MessagePack
+(client/get "http://site.com/foo" {:as :transit+json})
+(client/get "http://site.com/foo" {:as :transit+msgpack})
+
 ;; Coerce as a clojure datastructure
 (client/get "http://site.com/foo.clj" {:as :clojure})
 

project.clj

@@ -12,6 +12,7 @@
                  [org.apache.httpcomponents/httpmime "4.3.5"]
                  [commons-codec "1.9"]
                  [commons-io "2.4"]
+                 [com.cognitect/transit-clj "0.8.247"]
                  [slingshot "0.10.3"]
                  [cheshire "5.3.1"]
                  [crouton "0.1.2"]

src/clj_http/client.clj

@@ -37,6 +37,13 @@
     true
     (catch Throwable _ false)))
 
+;; Transit is an optional dependency, so check at compile time.
+(def transit-enabled?
+  (try
+    (require 'cognitect.transit)
+    true
+    (catch Throwable _ false)))
+
 (defn ^:dynamic parse-edn
   "Resolve and apply tool.reader's EDN parsing."
   [& args]
@@ -51,6 +58,14 @@
   {:pre [crouton-enabled?]}
   (apply (ns-resolve (symbol "crouton.html") (symbol "parse")) args))
 
+(defn ^:dynamic parse-transit
+  "Resolve and apply Transit's JSON/MessagePack parsing."
+  [& args]
+  {:pre [transit-enabled?]}
+  (let [reader (ns-resolve 'cognitect.transit 'reader)
+        read (ns-resolve 'cognitect.transit 'read)]
+    (read (apply reader args))))
+
 (defn ^:dynamic json-encode
   "Resolve and apply cheshire's json encoding dynamically."
   [& args]
@@ -92,7 +107,7 @@
 
 (defn url-encode-illegal-characters
   "Takes a raw url path or query and url-encodes any illegal characters.
-   Minimizes ambiguity by encoding space to %20."
+  Minimizes ambiguity by encoding space to %20."
   [path-or-query]
   (when path-or-query
     (-> path-or-query
@@ -311,6 +326,12 @@
       (binding [*read-eval* false]
         (assoc resp :body (read-string (String. ^"[B" body charset)))))))
 
+(defn coerce-transit-body
+  [{:keys [transit-opts] :as request} {:keys [body] :as resp} type]
+  (if transit-enabled?
+    (assoc resp :body (parse-transit body type transit-opts))
+    resp))
+
 (defmulti coerce-content-type (fn [req resp] (:content-type resp)))
 
 (defmethod coerce-content-type :application/clojure [req resp]
@@ -322,6 +343,12 @@
 (defmethod coerce-content-type :application/json [req resp]
   (coerce-json-body req resp true false))
 
+(defmethod coerce-content-type :application/transit+json [req resp]
+  (coerce-transit-body req resp :json))
+
+(defmethod coerce-content-type :application/transit+msgpack [req resp]
+  (coerce-transit-body req resp :msgpack))
+
 (defmethod coerce-content-type :default [req resp]
   (if-let [charset (-> resp :content-type-params :charset)]
     (coerce-response-body {:as charset} resp)
@@ -347,6 +374,12 @@
 (defmethod coerce-response-body :clojure [req resp]
   (coerce-clojure-body req resp))
 
+(defmethod coerce-response-body :transit+json [req resp]
+  (coerce-transit-body req resp :json))
+
+(defmethod coerce-response-body :transit+msgpack [req resp]
+  (coerce-transit-body req resp :msgpack))
+
 (defmethod coerce-response-body :default
   [{:keys [as]} {:keys [status body] :as resp}]
   (let [body-bytes (util/force-byte-array body)]
@@ -590,6 +623,49 @@
                   (assoc :request-method m)))
       (client req))))
 
+(defmulti coerce-form-params
+  (fn [req] (keyword (content-type-value (:content-type req)))))
+
+(defmethod coerce-form-params :application/edn
+  [{:keys [form-params]}]
+  (pr-str form-params))
+
+(defn-  coerce-transit-form-params [type {:keys [form-params transit-opts]}]
+  (when-not transit-enabled?
+    (throw (ex-info (format (str "Can't encode form params as \"application/transit+%s\". "
+                                 "Transit dependency not loaded.")
+                            (name type))
+                    {:type :transit-not-loaded
+                     :form-params form-params
+                     :transit-opts transit-opts
+                     :transit-type type})))
+  (let [output (java.io.ByteArrayOutputStream.)
+        writer (ns-resolve 'cognitect.transit 'writer)
+        write (ns-resolve 'cognitect.transit 'write)
+        _ (write (writer output type transit-opts) form-params)
+        bytes (.toByteArray output)]
+    (.reset output)
+    bytes))
+
+(defmethod coerce-form-params :application/transit+json [req]
+  (coerce-transit-form-params :json req))
+
+(defmethod coerce-form-params :application/transit+msgpack [req]
+  (coerce-transit-form-params :msgpack req))
+
+(defmethod coerce-form-params :application/json
+  [{:keys [form-params json-opts]}]
+  (when-not json-enabled?
+    (throw (ex-info (str "Can't encode form params as \"application/json\". "
+                         "Cheshire dependency not loaded.")
+                    {:type :cheshire-not-loaded
+                     :form-params form-params
+                     :json-opts json-opts})))
+  (json-encode form-params json-opts))
+
+(defmethod coerce-form-params :default [{:keys [content-type form-params]}]
+  (generate-query-string form-params (content-type-value content-type)))
+
 (defn wrap-form-params
   "Middleware wrapping the submission or form parameters."
   [client]
@@ -600,10 +676,7 @@
       (client (-> req
                   (dissoc :form-params)
                   (assoc :content-type (content-type-value content-type)
-                         :body (if (and (= content-type :json) json-enabled?)
-                                 (json-encode form-params json-opts)
-                                 (generate-query-string form-params
-                                                        (content-type-value content-type))))))
+                         :body (coerce-form-params req))))
       (client req))))
 
 (defn- nest-params

test/clj_http/test/client.clj

@@ -280,7 +280,13 @@
 (deftest apply-on-accept
   (is-applied client/wrap-accept
               {:accept :json}
-              {:headers {"accept" "application/json"}}))
+              {:headers {"accept" "application/json"}})
+  (is-applied client/wrap-accept
+              {:accept :transit+json}
+              {:headers {"accept" "application/transit+json"}})
+  (is-applied client/wrap-accept
+              {:accept :transit+msgpack}
+              {:headers {"accept" "application/transit+msgpack"}}))
 
 (deftest pass-on-no-accept
   (is-passed client/wrap-accept
@@ -349,7 +355,15 @@
   (is-applied client/wrap-content-type
               {:content-type :json :character-encoding "UTF-8"}
               {:headers {"content-type" "application/json; charset=UTF-8"}
-               :content-type :json :character-encoding "UTF-8"}))
+               :content-type :json :character-encoding "UTF-8"})
+  (is-applied client/wrap-content-type
+              {:content-type :transit+json}
+              {:headers {"content-type" "application/transit+json"}
+               :content-type :transit+json})
+  (is-applied client/wrap-content-type
+              {:content-type :transit+msgpack}
+              {:headers {"content-type" "application/transit+msgpack"}
+               :content-type :transit+msgpack}))
 
 (deftest pass-on-no-content-type
   (is-passed client/wrap-content-type
@@ -437,6 +451,7 @@
       (is (= "param1=value1&param2=value2" (:body resp)))
       (is (= "application/x-www-form-urlencoded" (:content-type resp)))
       (is (not (contains? resp :form-params)))))
+
   (testing "With json form params"
     (let [param-client (client/wrap-form-params identity)
           params {:param1 "value1" :param2 "value2"}
@@ -471,6 +486,40 @@
       (is (= (json/encode params {:date-format "yyyy-MM-dd"}) (:body resp)))
       (is (= "application/json" (:content-type resp)))
       (is (not (contains? resp :form-params)))))
+
+  (testing "With EDN form params"
+    (doseq [method [:post :put :patch]]
+      (let [param-client (client/wrap-form-params identity)
+            params {:param1 "value1" :param2 "value2"}
+            resp (param-client {:request-method method
+                                :content-type :edn
+                                :form-params params})]
+        (is (= (pr-str params) (:body resp)))
+        (is (= "application/edn" (:content-type resp)))
+        (is (not (contains? resp :form-params))))))
+
+  (testing "With Transit/JSON form params"
+    (doseq [method [:post :put :patch]]
+      (let [param-client (client/wrap-form-params identity)
+            params {:param1 "value1" :param2 "value2"}
+            resp (param-client {:request-method method
+                                :content-type :transit+json
+                                :form-params params})]
+        (is (= params (client/parse-transit (ByteArrayInputStream. (:body resp)) :json)))
+        (is (= "application/transit+json" (:content-type resp)))
+        (is (not (contains? resp :form-params))))))
+
+  (testing "With Transit/MessagePack form params"
+    (doseq [method [:post :put :patch]]
+      (let [param-client (client/wrap-form-params identity)
+            params {:param1 "value1" :param2 "value2"}
+            resp (param-client {:request-method method
+                                :content-type :transit+msgpack
+                                :form-params params})]
+        (is (= params (client/parse-transit (ByteArrayInputStream. (:body resp)) :msgpack)))
+        (is (= "application/transit+msgpack" (:content-type resp)))
+        (is (not (contains? resp :form-params))))))
+
   (testing "Ensure it does not affect GET requests"
     (let [param-client (client/wrap-form-params identity)
           resp (param-client {:request-method :get
@@ -479,6 +528,7 @@
                                             :param2 "value2"}})]
       (is (= "untouched" (:body resp)))
       (is (not (contains? resp :content-type)))))
+
   (testing "with no form params"
     (let [param-client (client/wrap-form-params identity)
           resp (param-client {:body "untouched"})]
@@ -616,16 +666,26 @@
   (let [json-body (ByteArrayInputStream. (.getBytes "{\"foo\":\"bar\"}"))
         auto-body (ByteArrayInputStream. (.getBytes "{\"foo\":\"bar\"}"))
         edn-body (ByteArrayInputStream. (.getBytes "{:foo \"bar\"}"))
+        transit-json-body (ByteArrayInputStream. (.getBytes "[\"^ \",\"~:foo\",\"bar\"]"))
+        transit-msgpack-body (->> (map byte [-127 -91 126 58 102 111 111 -93 98 97 114])
+                                  (byte-array 11)
+                                  (ByteArrayInputStream.))
         json-resp {:body json-body :status 200
                    :headers {"content-type" "application/json"}}
         auto-resp {:body auto-body :status 200
                    :headers {"content-type" "application/json"}}
         edn-resp {:body edn-body :status 200
-                  :headers {"content-type" "application/edn"}}]
+                  :headers {"content-type" "application/edn"}}
+        transit-json-resp {:body transit-json-body :status 200
+                           :headers {"content-type" "application/transit-json"}}
+        transit-msgpack-resp {:body transit-msgpack-body :status 200
+                              :headers {"content-type" "application/transit-msgpack"}}]
     (is (= {:foo "bar"}
            (:body (client/coerce-response-body {:as :json} json-resp))
            (:body (client/coerce-response-body {:as :clojure} edn-resp))
-           (:body (client/coerce-response-body {:as :auto} auto-resp))))))
+           (:body (client/coerce-response-body {:as :auto} auto-resp))
+           (:body (client/coerce-response-body {:as :transit+json} transit-json-resp))
+           (:body (client/coerce-response-body {:as :transit+msgpack} transit-msgpack-resp))))))
 
 (deftest ^:integration t-with-middleware
   (run-server)

test/clj_http/test/core.clj

@@ -51,6 +51,18 @@
     [:get "/redirect-to-get"]
     {:status 302
      :headers {"location" "http://localhost:18080/get"}}
+    [:get "/transit-json"]
+    {:status 200 :body "[\"^ \",\"~:eggplant\",[\"^ \",\"~:quux\",[\"~#set\",[1,3,2]]],\"~:baz\",\"~f7\",\"~:foo\",\"bar\"]"
+     :headers {"content-type" "application/transit+json"}}
+    [:get "/transit-msgpack"]
+    {:status 200
+     :body (->> [-125 -86 126 58 101 103 103 112 108 97 110 116 -127 -90 126 58 113 117
+                 117 120 -110 -91 126 35 115 101 116 -109 1 3 2 -91 126 58 98 97 122 -93
+                 126 102 55 -91 126 58 102 111 111 -93 98 97 114]
+                (map byte)
+                (byte-array)
+                (ByteArrayInputStream.))
+     :headers {"content-type" "application/transit+msgpack"}}
     [:head "/head"]
     {:status 200}
     [:get "/content-type"]
@@ -324,6 +336,17 @@
            (:body clj-resp)
            (:body edn-resp)))))
 
+(deftest ^:integration t-transit-output-coercion
+  (run-server)
+  (let [transit-json-resp (client/get (localhost "/transit-json") {:as :auto})
+        transit-msgpack-resp (client/get (localhost "/transit-msgpack") {:as :auto})]
+    (is (= 200
+           (:status transit-json-resp)
+           (:status transit-msgpack-resp)))
+    (is (= {:foo "bar" :baz 7M :eggplant {:quux #{1 2 3}}}
+           (:body transit-json-resp)
+           (:body transit-msgpack-resp)))))
+
 (deftest ^:integration t-json-output-coercion
   (run-server)
   (let [resp (client/get (localhost "/json") {:as :json})