Extraction.

.gitignore

@@ -0,0 +1,11 @@
+.DS_Store
+/target
+/lib
+/classes
+/checkouts
+pom.xml
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins

LICENSE

@@ -0,0 +1,22 @@
+Copyright (c) 2013 Bertrand Karerangabo
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.

README.md

@@ -0,0 +1,37 @@
+# Ring-Gzip
+
+Ring middleware for gzip compression.
+
+## Installation
+
+To use this libary, add the following to your Leingingen `:dependencies`:
+
+    [bk/ring-gzip "0.1.0"]
+
+## Usage
+
+The `wrap-gzip` middleware will compress any supported responses before
+sending them to compatible user-agents. Typically, the middleware would
+be applied to your Ring handler at the top level (i.e. as the last form
+in a `->` function).
+
+```clojure
+(ns app.core
+  (:use  [ring.middleware.gzip]
+         [ring.middleware params
+                          keyword-params
+                          nested-params]))
+
+(def app
+  (-> handler
+    (wrap-keyword-params)
+    (wrap-nested-params)
+    (wrap-params
+    (wrap-gzip))))
+```
+
+## License
+
+Copyright © 2013 Bertrand Karerangabo
+
+Distributed under the MIT License (see LICENSE).

project.clj

@@ -0,0 +1,6 @@
+(defproject bk/ring-gzip "0.1.0"
+  :description "Middleware that compresses repsonses with gzip for supported
+               user-agents."
+  :url "https://github.com/bertrandk/ring-gzip"
+  :license {:name "MIT-style license (see LICENSE for details)."}
+  :dependencies [[org.clojure/clojure "1.4.0"]])

src/ring/middleware/gzip.clj

@@ -0,0 +1,99 @@
+(ns ring.middleware.gzip
+  "Ring gzip compression."
+  (:require [clojure.java.io :as io])
+  (:import (java.io InputStream
+                    Closeable
+                    File
+                    PipedInputStream
+                    PipedOutputStream)
+           (java.util.zip GZIPOutputStream)))
+
+(defn- accepts-gzip?
+  [req]
+  (if-let [accepts (get-in req [:headers "accept-encoding"])]
+    ;; Be aggressive in supporting clients with mangled headers (due to
+    ;; proxies, av software, buggy browsers, etc...)
+    (seq
+      (re-find
+        #"(gzip\s*,?\s*(gzip|deflate)?|X{4,13}|~{4,13}|\-{4,13})"
+        accepts))))
+
+;; Set Vary to make sure proxies don't deliver the wrong content.
+(defn- set-response-headers
+  [headers]
+  (if-let [vary (get headers "vary")]
+    (-> headers
+      (assoc "Vary" (str vary ", Accept-Encoding"))
+      (assoc "Content-Encoding" "gzip")
+      (dissoc "Content-Length")
+      (dissoc "vary"))
+    (-> headers
+      (assoc "Vary" "Accept-Encoding")
+      (assoc "Content-Encoding" "gzip")
+      (dissoc "Content-Length"))))
+
+(def ^:private supported-status? #{200, 201, 202, 203, 204, 205 403, 404})
+
+(defn- unencoded-type?
+  [headers]
+  (if (headers "content-encoding")
+    false
+    true))
+
+(defn- supported-type?
+  [resp]
+  (let [{:keys [headers body]} resp]
+    (or (string? body)
+        (seq? body)
+        (instance? InputStream body)
+        (and (instance? File body) 
+             (re-find #"(?i)\.(htm|html|css|js|json|xml)" (pr-str body))))))
+
+(def ^:private min-length 859)
+
+(defn- supported-size?
+  [resp]
+  (let [{body :body} resp]
+    (cond
+      (string? body) (> (count body) min-length)
+      (seq? body) (> (count body) min-length)
+      (instance? File body) (> (.length body) min-length)
+      :else true)))
+
+(defn- supported-response?
+  [resp]
+  (let [{:keys [status headers]} resp]
+    (and (supported-status? status)
+         (unencoded-type? headers)
+         (supported-type? resp)
+         (supported-size? resp))))
+
+(defn- compress-body
+  [body]
+  (let [p-in (PipedInputStream.)
+        p-out (PipedOutputStream. p-in)]
+    (future
+      (with-open [out (GZIPOutputStream. p-out)]
+        (if (seq? body)
+          (doseq [string body] (io/copy (str string) out))
+          (io/copy body out)))
+      (when (instance? Closeable body)
+        (.close body)))
+    p-in))
+
+(defn- gzip-response
+  [resp]
+  (-> resp
+    (update-in [:headers] set-response-headers)
+    (update-in [:body] compress-body)))
+
+(defn wrap-gzip
+  "Middleware that compresses responses with gzip for supported user-agents."
+  [handler]
+  (fn [req]
+    (if (accepts-gzip? req)
+      (let [resp (handler req)]
+        (if (supported-response? resp)
+          (gzip-response resp)
+          resp))
+      (handler req))))

test/ring/middleware/gzip_test.clj

@@ -0,0 +1,142 @@
+(ns ring.middleware.gzip-test
+  (:use clojure.test
+        ring.middleware.gzip)
+  (:require [clojure.java.io :as io])
+  (:import (java.io PipedInputStream)))
+
+(def short-string "Note that gzipping is only beneficial for larger
+                  resources. Due to the overhead and latency of
+                  compression and decompression, you should only gzip
+                  files above a certain size threshold; Google
+                  recommends a minimum range between 150 and 1000 bytes.
+                  Gzipping files below 150 bytes can actually make them
+                  larger. According to Akamai, the reasons 860 bytes is
+                  the minimum size for compression is twofold: (1) The
+                  overhead of compressing an object under 860 bytes
+                  outweighs performance gain. (2) Objects under 860
+                  bytes can be transmitted via a single packet anyway,
+                  so there isn't a compelling reason to compress them.")
+
+(def long-string (apply str (repeat 860 "a")))
+
+(def long-seq (repeat 860 "a"))
+
+(def long-stream
+  (with-open [in (io/input-stream (byte-array (map byte (repeat 860 0))))]
+    in))
+
+(defn req
+  [& {:keys [server-port server-name remote-addr uri scheme request-method
+             headers] :or {server-port 80 server-name "localhost" remote-addr
+                           "127.0.0.1" uri "/index" scheme :http request-method
+                           :get headers {}}}]
+  {:server-port server-port
+   :server-name server-name
+   :remote-addr remote-addr
+   :uri uri
+   :scheme scheme
+   :request-method request-method
+   :headers headers})
+
+(deftest test-wrap-gzip
+
+         (testing "valid-accept-encoding"
+                  (doseq [accept-encoding ["gzip" "gzip,deflate"
+                                           "gzip,deflate,sdch" "deflate,gzip"
+                                           "gzip, deflate" "XXXX" "~~~~"
+                                           "-------------"]
+                          :let [handler (constantly {:status 200 :headers {}
+                                                     :body long-string})
+                                req (req :headers {"accept-encoding"
+                                                   accept-encoding})
+                                resp ((wrap-gzip handler) req)]]
+                    (is (true? (instance? java.io.PipedInputStream
+                                          (resp :body))))))
+
+         (testing "invalid-accept-encoding"
+                  (doseq [accept-encoding ["" "deflate" "deflate,sdch"
+                                           " deflate"]
+                          :let [handler (constantly {:status 200 :headers {}
+                                                     :body long-string})
+                                req (req :headers {"accept-encoding"
+                                                   accept-encoding})
+                                resp ((wrap-gzip handler) req)]]
+                    (is (false? (instance? java.io.PipedInputStream
+                                           (resp :body))))))
+
+         (testing "response-headers"
+                  (let [handler (constantly {:status 200 :headers {}
+                                             :body long-string})
+                        req (req :headers {"accept-encoding" "gzip"})
+                        resp ((wrap-gzip handler) req)]
+                    (is (= (get-in resp [:headers "Vary"]) "Accept-Encoding"))
+                    (is (= (get-in resp [:headers "Content-Encoding"])
+                           "gzip"))
+                    (is (= (get-in resp [:headers "Content Length"]) nil))))
+
+         (testing "response-headers-with-existing-vary"
+                  (let [handler (constantly {:status 200
+                                             :headers {"vary" "Accept-Language"}
+                                             :body long-string})
+                        req (req :headers {"accept-encoding" "gzip"})
+                        resp ((wrap-gzip handler) req)]
+                    (is (= (get-in resp [:headers "Vary"])
+                           "Accept-Language, Accept-Encoding"))
+                    (is (= (get-in resp [:headers "Content-Encoding"])
+                           "gzip"))
+                    (is (= (get-in resp [:headers "Content Length"]) nil))))
+
+         (testing "supported-statuses"
+                  (doseq [status [200, 201, 202, 203, 204, 205, 403, 404]
+                          :let [handler (constantly {:status status :headers {}
+                                                     :body long-string})
+                                req (req :headers {"accept-encoding" "gzip"})
+                                resp ((wrap-gzip handler) req)]]
+                    (is (= (get-in resp [:headers "Content-Encoding"])
+                           "gzip"))))
+
+         (testing "unsupported-statuses"
+                  (doseq [status [206, 301, 302, 304, 305, 307, 400, 401, 502]
+                          :let [handler (constantly {:status status :headers {}
+                                                     :body long-string})
+                                req (req :headers {"accept-encoding" "gzip"})
+                                resp ((wrap-gzip handler) req)]]
+                    (is (not= (get-in resp [:headers "Content-Encoding"])
+                              "gzip"))))
+
+         (testing "response-headers-with-encoded-type"
+                  (let [handler (constantly {:status 200
+                                             :headers {"content-encoding"
+                                                       "deflate"}
+                                             :body long-string})
+                        req (req :headers {"accept-encoding" "deflate, gzip"})
+                        resp ((wrap-gzip handler) req)]
+                    (is (not= (get-in resp [:headers "Content-Encoding"])
+                              "gzip"))))
+
+         (testing "small-response-size"
+                  (let [handler (constantly {:status 200
+                                             :headers {}
+                                             :body short-string})
+                        req (req :headers {"accept-encoding" "gzip"})
+                        resp ((wrap-gzip handler) req)]
+                    (is (not= (get-in resp [:headers "Content-Encoding"])
+                              "gzip"))))
+
+         (testing "large-response-size"
+                  (let [handler (constantly {:status 200
+                                             :headers {}
+                                             :body long-string})
+                        req (req :headers {"accept-encoding" "gzip"})
+                        resp ((wrap-gzip handler) req)]
+                    (is (= (get-in resp [:headers "Content-Encoding"])
+                           "gzip"))))
+
+         (testing "response-types"
+                  (doseq [body [long-string long-seq long-stream]
+                          :let [handler (constantly {:status 200 :headers {}
+                                                     :body body})
+                                req (req :headers {"accept-encoding" "gzip"})
+                                resp ((wrap-gzip handler) req)]]
+                    (is (= (get-in resp [:headers "Content-Encoding"])
+                           "gzip")))))