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 ))
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)))
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)))
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