Skip to content

Commit 4400074

Browse files
author
jj
committed
Enable json-tls for ring-http-exchange
1 parent 7a4de02 commit 4400074

3 files changed

Lines changed: 191 additions & 122 deletions

File tree

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,16 @@
1-
FROM clojure:temurin-21-lein AS builder
1+
FROM clojure:temurin-26-lein-trixie AS builder
22
WORKDIR /app
33
COPY project.clj ./
44
COPY resources ./resources
55
RUN lein deps
66
COPY src ./src
77
RUN lein with-profile uberjar uberjar
88

9-
FROM eclipse-temurin:25-jre
9+
FROM eclipse-temurin:26-jre
1010
RUN mkdir -p /data/static
1111
WORKDIR /app
1212
COPY --from=builder /app/target/ring-0.1.0-standalone.jar /app/app.jar
1313

14-
EXPOSE 8080
14+
EXPOSE 8080 8081
1515

1616
ENTRYPOINT ["java", "-jar", "app.jar"]

frameworks/ring-http-exchange/meta.json

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@
1414
"upload",
1515
"short-lived",
1616
"mixed",
17+
"json-tls",
1718
"api-4",
1819
"api-16",
1920
"async-db",

frameworks/ring-http-exchange/src/ring/core.clj

Lines changed: 187 additions & 119 deletions
Original file line numberDiff line numberDiff line change
@@ -6,10 +6,13 @@
66
[jj.tassu :refer [GET POST route]]
77
[jsonista.core :as json]
88
[next.jdbc :as jdbc]
9-
[ring-http-exchange.core :as server])
9+
[ring-http-exchange.core :as server]
10+
[ring-http-exchange.ssl :as ssl])
1011
(:import (com.zaxxer.hikari HikariConfig HikariDataSource)
11-
(java.io BufferedInputStream ByteArrayOutputStream InputStream)
12+
(java.io ByteArrayOutputStream FileInputStream InputStream OutputStream)
1213
(java.net URI)
14+
(java.security KeyStore PEMDecoder PrivateKey)
15+
(java.security.cert Certificate CertificateFactory)
1316
(java.util.concurrent Executors)
1417
(java.util.zip GZIPOutputStream))
1518
(:gen-class))
@@ -38,11 +41,25 @@
3841
(def ^:private ^:const pg-prefix "postgres://")
3942
(def ^:private ^:const pg-replace "postgresql://")
4043

41-
(def ^:private json-headers {hdr-ct ct-json hdr-server server-name})
44+
(def ^:private ^:const plain-port 8080)
45+
(def ^:private ^:const tls-port 8081)
46+
(def ^:private ^:const tls-cert-default "/certs/server.crt")
47+
(def ^:private ^:const tls-key-default "/certs/server.key")
48+
49+
(def ^:private json-headers {hdr-ct ct-json hdr-server server-name})
4250
(def ^:private json-gzip-headers {hdr-ct ct-json hdr-ce enc-gzip hdr-server server-name})
43-
(def ^:private text-headers {hdr-ct ct-text hdr-server server-name})
51+
(def ^:private text-headers {hdr-ct ct-text hdr-server server-name})
4452
(def ^:private empty-db-response {:status 200 :headers json-headers :body empty-db-body})
4553

54+
(def ^:private ^:const extension-map
55+
{".css" "text/css"
56+
".js" "application/javascript"
57+
".html" "text/html"
58+
".woff2" "font/woff2"
59+
".svg" "image/svg+xml"
60+
".webp" "image/webp"
61+
".json" ct-json})
62+
4663
(defn- load-json [path]
4764
(when (.exists (io/file path))
4865
(json/read-value (slurp path) json/keyword-keys-object-mapper)))
@@ -57,29 +74,30 @@
5774
(persistent! m)
5875
(let [amp (.indexOf qs (int \&) i)
5976
end (if (neg? amp) (.length qs) amp)
60-
eq (.indexOf qs (int \=) i)]
77+
eq (.indexOf qs (int \=) i)]
6178
(if (and (>= eq 0) (< eq end))
6279
(recur (inc end) (assoc! m (subs qs i eq) (subs qs (inc eq) end)))
6380
(recur (inc end) m)))))))
6481

6582
(defn- sum-params [^String qs]
66-
(if (nil? qs) 0
67-
(loop [i 0 total-sum 0]
68-
(if (>= i (.length qs))
69-
total-sum
70-
(let [amp (.indexOf qs (int \&) i)
71-
end (if (neg? amp) (.length qs) amp)
72-
eq (.indexOf qs (int \=) i)]
73-
(if (and (>= eq 0) (< eq end))
74-
(recur (inc end)
75-
(+ total-sum
76-
(long (try (Long/parseLong (subs qs (inc eq) end))
77-
(catch Exception _ 0)))))
78-
(recur (inc end) total-sum)))))))
83+
(if (nil? qs)
84+
0
85+
(loop [i 0 total-sum 0]
86+
(if (>= i (.length qs))
87+
total-sum
88+
(let [amp (.indexOf qs (int \&) i)
89+
end (if (neg? amp) (.length qs) amp)
90+
eq (.indexOf qs (int \=) i)]
91+
(if (and (>= eq 0) (< eq end))
92+
(recur (inc end)
93+
(+ total-sum
94+
(long (try (Long/parseLong (subs qs (inc eq) end))
95+
(catch Exception _ 0)))))
96+
(recur (inc end) total-sum)))))))
7997

8098
(defn- gzip-bytes [^bytes data]
8199
(let [baos (ByteArrayOutputStream. (alength data))
82-
gos (GZIPOutputStream. baos)]
100+
gos (GZIPOutputStream. baos)]
83101
(.write gos data)
84102
(.close gos)
85103
(.toByteArray baos)))
@@ -96,111 +114,161 @@
96114
(defn- parse-double-param [params k default]
97115
(try (Double/parseDouble (get params k)) (catch Exception _ default)))
98116

99-
(def ^:private ^:const extension-map
100-
{".css" "text/css"
101-
".js" "application/javascript"
102-
".html" "text/html"
103-
".woff2" "font/woff2"
104-
".svg" "image/svg+xml"
105-
".webp" "image/webp"
106-
".json" ct-json})
117+
(defn- accepts-gzip? [headers]
118+
(boolean
119+
(some (fn [[k v]]
120+
(and (.equalsIgnoreCase ^String k ae-header)
121+
(.contains ^String v enc-gzip)))
122+
headers)))
107123

108124
(defn- get-content-type [^String name]
109125
(let [dot-index (.lastIndexOf name ^String dot)
110-
ext (if (>= dot-index 0) (subs name dot-index) "")]
126+
ext (if (>= dot-index 0) (subs name dot-index) "")]
111127
(get extension-map ext ct-octet)))
112128

113129
(defn- transform-row [row parse-tags parse-active]
114-
{:id (:id row) :name (:name row) :category (:category row)
115-
:price (:price row) :quantity (:quantity row) :active (parse-active (:active row))
116-
:tags (parse-tags (:tags row))
117-
:rating {:score (:rating_score row) :count (:rating_count row)}})
130+
{:id (:id row)
131+
:name (:name row)
132+
:category (:category row)
133+
:price (:price row)
134+
:quantity (:quantity row)
135+
:active (parse-active (:active row))
136+
:tags (parse-tags (:tags row))
137+
:rating {:score (:rating_score row) :count (:rating_count row)}})
138+
139+
(defn- pem->keystore [^String cert-path ^String key-path]
140+
(let [certs (with-open [in (FileInputStream. cert-path)]
141+
(.generateCertificates (CertificateFactory/getInstance "X.509") in))
142+
cert-array (into-array Certificate certs)
143+
private-key ^PrivateKey (.decode (PEMDecoder/of) ^String (slurp key-path) PrivateKey)
144+
password (char-array 0)]
145+
(doto (KeyStore/getInstance "PKCS12")
146+
(.load nil password)
147+
(.setKeyEntry "server" private-key password cert-array))))
148+
149+
(defn- load-ssl-context
150+
[]
151+
(let [cert-path (or (System/getenv "TLS_CERT") tls-cert-default)
152+
key-path (or (System/getenv "TLS_KEY") tls-key-default)]
153+
(if (and (.exists (io/file cert-path)) (.exists (io/file key-path)))
154+
(try
155+
(ssl/keystore->ssl-context (pem->keystore cert-path key-path) "")
156+
(catch Exception e
157+
(println (str "Failed to load TLS context: " (.getMessage e)))
158+
nil))
159+
(do
160+
(println (str "TLS certs not found at " cert-path " / " key-path
161+
" - skipping TLS server"))
162+
nil))))
163+
164+
(defn- start-server!
165+
([handler port]
166+
(start-server! handler port nil))
167+
([handler port ssl-context]
168+
(let [opts (cond-> {:port port
169+
:lazy-request-map? true
170+
:executor default-executor}
171+
ssl-context (assoc :ssl-context ssl-context))]
172+
(try
173+
(server/run-http-server handler opts)
174+
(println (str "Server running on port " port (when ssl-context " (TLS)")))
175+
(catch Exception e
176+
(println (str "Failed to start server on port " port
177+
": " (.getMessage e))))))))
178+
179+
(defn- init-sqlite []
180+
(when (.exists (io/file db-path))
181+
{:ds (jdbc/get-datasource {:dbtype "sqlite" :dbname db-path :read-only true})
182+
:query (boa/build-query (->NextJdbcAdapter) "sql/db-query")}))
183+
184+
(defn- init-postgres []
185+
(when-let [url (System/getenv "DATABASE_URL")]
186+
(try
187+
(let [uri (URI. (str/replace url pg-prefix pg-replace))
188+
host (.getHost uri)
189+
port (if (pos? (.getPort uri)) (.getPort uri) 5432)
190+
db (subs (.getPath uri) 1)
191+
[user pass] (str/split (.getUserInfo uri) #":" 2)
192+
max-conn (try (Integer/parseInt (System/getenv "DATABASE_MAX_CONN"))
193+
(catch Exception _ 256))
194+
cfg (doto (HikariConfig.)
195+
(.setJdbcUrl (str "jdbc:postgresql://" host ":" port "/" db))
196+
(.setUsername user)
197+
(.setPassword (or pass ""))
198+
(.setMaximumPoolSize max-conn)
199+
(.setReadOnly true))]
200+
{:ds (HikariDataSource. cfg)
201+
:query (boa/build-query (->NextJdbcAdapter) "sql/pg-query")})
202+
(catch Exception _ nil))))
203+
204+
(defn- handle-baseline-get [req]
205+
(text-response (sum-params (:query-string req))))
206+
207+
(defn- handle-baseline-post [req]
208+
(let [s (sum-params (:query-string req))
209+
b (slurp (:body req))
210+
n (try (Long/parseLong (str/trim b)) (catch Exception _ 0))]
211+
(text-response (+ s n))))
212+
213+
(defn- handle-json [dataset req]
214+
(let [requested (try (Long/parseLong (get-in req [:params :count]))
215+
(catch Exception _ 50))
216+
n (min requested (long (clojure.core/count dataset)))
217+
params (parse-qs (:query-string req))
218+
m (parse-long-param params param-m 1)
219+
items (map #(process-item % m) (subvec dataset 0 n))
220+
body-bytes (json/write-value-as-bytes
221+
{:items items :count (clojure.core/count items)})]
222+
(if (accepts-gzip? (:headers req))
223+
{:status 200 :headers json-gzip-headers :body (gzip-bytes body-bytes)}
224+
{:status 200 :headers json-headers :body (String. ^bytes body-bytes)})))
225+
226+
(defn- handle-upload [req]
227+
(with-open [^InputStream in (:body req)]
228+
(text-response (.transferTo in (OutputStream/nullOutputStream)))))
229+
230+
(defn- handle-db
231+
[db parse-tags parse-active req]
232+
(if-let [query (:query db)]
233+
(let [params (parse-qs (:query-string req))
234+
min-p (parse-double-param params param-min 10.0)
235+
max-p (parse-double-param params param-max 50.0)
236+
limit (parse-long-param params param-limit 50)
237+
items (try (map #(transform-row % parse-tags parse-active)
238+
(query (:ds db) {:min min-p :max max-p :limit limit}))
239+
(catch Exception _ []))]
240+
(json-response {:items items :count (clojure.core/count items)}))
241+
empty-db-response))
242+
243+
(defn- handle-static [req]
244+
(let [name (get-in req [:params :filename])
245+
f (io/file static-dir name)]
246+
(if (.exists f)
247+
{:status 200
248+
:headers {hdr-ct (get-content-type name) hdr-server server-name}
249+
:body f}
250+
{:status 404 :body not-found-body})))
251+
252+
(defn- build-handler [{:keys [dataset sqlite postgres]}]
253+
(let [sqlite-tag-parser #(json/read-value % json/keyword-keys-object-mapper)
254+
sqlite-active #(== 1 (long %))
255+
pg-tag-parser #(json/read-value (str %))]
256+
(route
257+
{"/baseline11" [(GET handle-baseline-get)
258+
(POST handle-baseline-post)]
259+
"/json/:count" [(GET (partial handle-json dataset))]
260+
"/upload" [(POST handle-upload)]
261+
"/db" [(GET (partial handle-db sqlite sqlite-tag-parser sqlite-active))]
262+
"/async-db" [(GET (partial handle-db postgres pg-tag-parser identity))]
263+
"/static/:filename" [(GET handle-static)]
264+
"/" [(GET (fn [_] (text-response server-name)))]})))
118265

119266
(defn -main [& _]
120-
(let [dataset (load-json (or (System/getenv "DATASET_PATH") dataset-path))
121-
adapter (->NextJdbcAdapter)
122-
sqlite-tag-parser #(json/read-value % json/keyword-keys-object-mapper)
123-
sqlite-active #(== 1 (long %))
124-
pg-tag-parser #(json/read-value (str %))
125-
db-file-exists? (.exists (io/file db-path))
126-
db-query-fn (when db-file-exists?
127-
(boa/build-query adapter "sql/db-query"))
128-
sqlite-ds (when db-file-exists?
129-
(jdbc/get-datasource {:dbtype "sqlite" :dbname db-path :read-only true}))
130-
pg-state (when-let [url (System/getenv "DATABASE_URL")]
131-
(try
132-
(let [uri (URI. (str/replace url pg-prefix pg-replace))
133-
host (.getHost uri)
134-
port (if (pos? (.getPort uri)) (.getPort uri) 5432)
135-
db (subs (.getPath uri) 1)
136-
[user pass] (str/split (.getUserInfo uri) #":" 2)
137-
ds (let [cfg (doto (HikariConfig.)
138-
(.setJdbcUrl (str "jdbc:postgresql://" host ":" port "/" db))
139-
(.setUsername user)
140-
(.setPassword (or pass ""))
141-
(.setMaximumPoolSize (try (Integer/parseInt (System/getenv "DATABASE_MAX_CONN"))
142-
(catch Exception _ 256)))
143-
(.setReadOnly true))]
144-
(HikariDataSource. cfg))]
145-
{:ds ds
146-
:query (boa/build-query adapter "sql/pg-query")})
147-
(catch Exception _ nil)))
148-
pg-ds (:ds pg-state)
149-
pg-query (:query pg-state)
150-
151-
handler
152-
(route
153-
{"/baseline11" [(GET (fn [req] (text-response (sum-params (:query-string req)))))
154-
(POST (fn [req]
155-
(let [s (sum-params (:query-string req))
156-
b (slurp (:body req))
157-
n (try (Long/parseLong (str/trim b)) (catch Exception _ 0))]
158-
(text-response (+ s n)))))]
159-
"/json/:count" [(GET (fn [req]
160-
(let [count (try (Long/parseLong (get-in req [:params :count])) (catch Exception _ 50))
161-
count (min count (long (clojure.core/count dataset)))
162-
params (parse-qs (:query-string req))
163-
m (parse-long-param params param-m 1)
164-
items (map #(process-item % m) (subvec dataset 0 count))
165-
body-bytes (json/write-value-as-bytes {:items items :count (clojure.core/count items)})
166-
ae (some (fn [[k v]] (when (.equalsIgnoreCase ^String k ae-header) v)) (:headers req))]
167-
(if (and ae (.contains ^String ae enc-gzip))
168-
{:status 200 :headers json-gzip-headers :body (gzip-bytes body-bytes)}
169-
{:status 200 :headers json-headers :body (String. body-bytes)}))))]
170-
"/upload" [(POST (fn [req]
171-
(with-open [^InputStream in (:body req)]
172-
(text-response (alength (.readAllBytes in))))))]
173-
"/db" [(GET (fn [req]
174-
(if db-query-fn
175-
(let [params (parse-qs (:query-string req))
176-
min-p (parse-double-param params param-min 10.0)
177-
max-p (parse-double-param params param-max 50.0)
178-
limit (parse-long-param params param-limit 50)
179-
items (try (map #(transform-row % sqlite-tag-parser sqlite-active)
180-
(db-query-fn sqlite-ds {:min min-p :max max-p :limit limit}))
181-
(catch Exception _ []))]
182-
(json-response {:items items :count (clojure.core/count items)}))
183-
empty-db-response)))]
184-
"/async-db" [(GET (fn [req]
185-
(if pg-query
186-
(let [params (parse-qs (:query-string req))
187-
min-p (parse-double-param params param-min 10.0)
188-
max-p (parse-double-param params param-max 50.0)
189-
limit (parse-long-param params param-limit 50)
190-
items (try (map #(transform-row % pg-tag-parser identity)
191-
(pg-query pg-ds {:min min-p :max max-p :limit limit}))
192-
(catch Exception _ []))]
193-
(json-response {:items items :count (clojure.core/count items)}))
194-
empty-db-response)))]
195-
"/static/:filename" [(GET (fn [req]
196-
(let [name (get-in req [:params :filename])
197-
f (io/file static-dir name)]
198-
(if (.exists f)
199-
{:status 200 :headers {hdr-ct (get-content-type name) hdr-server server-name} :body f}
200-
{:status 404 :body not-found-body}))))]
201-
"/" [(GET (fn [_] (text-response server-name)))]})]
202-
203-
(server/run-http-server handler {:port 8080
204-
:lazy-request-map? true
205-
:executor default-executor})
206-
(println "Server running on port 8080")))
267+
(let [dataset (load-json (or (System/getenv "DATASET_PATH") dataset-path))
268+
sqlite (init-sqlite)
269+
postgres (init-postgres)
270+
handler (build-handler {:dataset dataset
271+
:sqlite sqlite
272+
:postgres postgres})]
273+
(start-server! handler plain-port)
274+
(start-server! handler tls-port (load-ssl-context))))

0 commit comments

Comments
 (0)