Josha von Gizycki
4 years ago
parent
8d92817e15
commit
5c7f71b368
@ -1,24 +0,0 @@
|
|||||||
.devbar {
|
|
||||||
position: fixed;
|
|
||||||
bottom: 0;
|
|
||||||
left: 0;
|
|
||||||
width: 100%;
|
|
||||||
font-family: monospace;
|
|
||||||
background-color: #ccc;
|
|
||||||
|
|
||||||
ol {
|
|
||||||
list-style-type: none;
|
|
||||||
padding: 0;
|
|
||||||
margin: 0;
|
|
||||||
|
|
||||||
li {
|
|
||||||
padding: .5rem;
|
|
||||||
border: 1px solid black;
|
|
||||||
margin: .5rem;
|
|
||||||
|
|
||||||
pre {
|
|
||||||
margin: 0;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@ -1,46 +0,0 @@
|
|||||||
(ns wanijo.infrastructure.devmode
|
|
||||||
(:require [hiccup.core :as hcore]
|
|
||||||
[clojure.string :as cljs]))
|
|
||||||
|
|
||||||
(def bar-entries (atom []))
|
|
||||||
|
|
||||||
(defn send-to-bar [msg]
|
|
||||||
(swap! bar-entries #(conj % msg)))
|
|
||||||
|
|
||||||
(defn devmode-on? [req]
|
|
||||||
(let [query-param (get-in req [:query-params "dev"])
|
|
||||||
cookie (get-in req [:cookies "devmode" :value])]
|
|
||||||
(or (= query-param "on")
|
|
||||||
(and (= cookie "1")
|
|
||||||
(not= query-param "off")))))
|
|
||||||
|
|
||||||
(defn devbar [resp]
|
|
||||||
(hcore/html
|
|
||||||
[:section.devbar
|
|
||||||
[:ol
|
|
||||||
(for [entry @bar-entries]
|
|
||||||
[:li [:pre entry]])]]))
|
|
||||||
|
|
||||||
(defn append-devbar [resp]
|
|
||||||
(let [body (:body resp)
|
|
||||||
new-body (cljs/replace
|
|
||||||
body "</body>" (str (devbar resp) "</body>"))]
|
|
||||||
(assoc resp :body new-body)))
|
|
||||||
|
|
||||||
(defn wrap-devmode [handler]
|
|
||||||
(fn [req]
|
|
||||||
(let [on? (devmode-on? req)
|
|
||||||
query-param? (get-in req [:query-params "dev"])
|
|
||||||
new-req (assoc-in req [:session :devmode] on?)
|
|
||||||
resp (handler new-req)
|
|
||||||
new-resp (cond
|
|
||||||
on? (-> resp
|
|
||||||
append-devbar
|
|
||||||
(assoc-in [:cookies :devmode] 1))
|
|
||||||
(some? query-param?) (assoc-in
|
|
||||||
resp
|
|
||||||
[:cookies :devmode]
|
|
||||||
(if on? 1 0))
|
|
||||||
:else resp)]
|
|
||||||
(reset! bar-entries [])
|
|
||||||
new-resp)))
|
|
||||||
@ -0,0 +1,77 @@
|
|||||||
|
(ns wanijo.infrastructure.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))))
|
||||||
Loading…
Reference in new issue