the next restyling, some restructuring
Josha von Gizycki
5 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