You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
78 lines
2.4 KiB
78 lines
2.4 KiB
(ns wanijo.infra.gzip
|
|
(:require [clojure.java.io :as io])
|
|
(:import (java.io InputStream
|
|
Closeable
|
|
File
|
|
PipedInputStream
|
|
PipedOutputStream)
|
|
(java.util.zip GZIPOutputStream)))
|
|
|
|
(defn set-response-headers
|
|
[headers]
|
|
(if-let [vary (or (get headers "vary") (get headers "Vary"))]
|
|
(-> headers
|
|
(assoc "Vary" (str vary ", Accept-Encoding"))
|
|
(assoc "Content-Encoding" "gzip")
|
|
(dissoc "Content-Length" "content-length")
|
|
(dissoc "vary"))
|
|
(-> headers
|
|
(assoc "Vary" "Accept-Encoding")
|
|
(assoc "Content-Encoding" "gzip")
|
|
(dissoc "Content-Length" "content-length"))))
|
|
|
|
(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...)
|
|
(re-seq
|
|
#"(gzip\s*,?\s*(gzip|deflate)?|X{4,13}|~{4,13}|\-{4,13})"
|
|
accepts)))
|
|
|
|
(defn supported-response? [resp]
|
|
(let [{:keys [status headers body]} resp
|
|
min-bytes 859]
|
|
(and
|
|
;; correct status code
|
|
(#{200 201 202 203 204 205 403 404} status)
|
|
;; not already encoded
|
|
(not (or (headers "Content-Encoding")
|
|
(headers "content-encoding")))
|
|
;; correct data type in body
|
|
(or (string? body)
|
|
(seq? body)
|
|
(instance? InputStream body)
|
|
(and (instance? File body)
|
|
(re-seq #"(?i)\.(htm|html|css|js|json|xml)"
|
|
(pr-str body))))
|
|
;; sensible body sizes
|
|
(cond (string? body) (> (count body) min-bytes)
|
|
(seq? body) (> (count body) min-bytes)
|
|
(instance? File body) (> (.length body) min-bytes)
|
|
:else true))))
|
|
|
|
(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 ^Closeable body)))
|
|
p-in))
|
|
|
|
(defn gzip-response [resp]
|
|
(-> resp
|
|
(update :headers set-response-headers)
|
|
(update :body compress-body)))
|
|
|
|
(defn wrap-gzip [handler]
|
|
(fn [req]
|
|
(let [resp (handler req)]
|
|
(if (and (accepts-gzip? req)
|
|
(supported-response? resp))
|
|
(gzip-response resp)
|
|
resp))))
|