diff --git a/frameworks/ring-http-exchange/meta.json b/frameworks/ring-http-exchange/meta.json
index e81453575..74649750f 100644
--- a/frameworks/ring-http-exchange/meta.json
+++ b/frameworks/ring-http-exchange/meta.json
@@ -21,6 +21,7 @@
"sync-db",
"static",
"tcp-frag",
+ "fortunes",
"crud"
]
}
diff --git a/frameworks/ring-http-exchange/project.clj b/frameworks/ring-http-exchange/project.clj
index dfacdd827..f92864fd7 100644
--- a/frameworks/ring-http-exchange/project.clj
+++ b/frameworks/ring-http-exchange/project.clj
@@ -5,15 +5,13 @@
:url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.12.0"]
- [org.clojars.jj/ring-http-exchange "1.4.4"]
+ [org.clojars.jj/ring-http-exchange "1.4.5"]
[org.clojars.jj/tassu "1.0.4"]
- [org.clojars.jj/boa-sql "1.0.10"]
- [org.clojars.jj/next-jdbc-adapter "1.0.10"]
- [org.postgresql/postgresql "42.7.5"]
+ [org.clojars.jj/async-boa-sql "1.0.11"]
+ [org.clojars.jj/vertx-pg-client-async-boa-adapter "1.0.1"]
[metosin/jsonista "1.0.0"]
- [com.zaxxer/HikariCP "6.2.1"]
+ [org.clojars.jj/majavat "2.0.0"]
[io.github.robaho/httpserver "1.0.29"]
- [com.github.seancorfield/next.jdbc "1.3.1093"]
[org.clojure/core.cache "1.2.263"]]
:main ^:skip-aot ring.core
diff --git a/frameworks/ring-http-exchange/resources/fortunes.html b/frameworks/ring-http-exchange/resources/fortunes.html
new file mode 100644
index 000000000..5ede9bc49
--- /dev/null
+++ b/frameworks/ring-http-exchange/resources/fortunes.html
@@ -0,0 +1,10 @@
+
+
+Fortunes
+
+
+ | id | message |
|---|
+ {% for f only in fortunes %}| {{ f.id }} | {{ f.message }} |
+ {% endfor %}
+
+
\ No newline at end of file
diff --git a/frameworks/ring-http-exchange/resources/sql/crud-update b/frameworks/ring-http-exchange/resources/sql/crud-update
index 661458be0..f31f9701c 100644
--- a/frameworks/ring-http-exchange/resources/sql/crud-update
+++ b/frameworks/ring-http-exchange/resources/sql/crud-update
@@ -1 +1,4 @@
-UPDATE items SET name = :name, price = :price, quantity = :quantity WHERE id = :id
+UPDATE items
+SET name = :name, price = :price, quantity = :quantity
+WHERE id = :id
+RETURNING id
diff --git a/frameworks/ring-http-exchange/resources/sql/fortunes b/frameworks/ring-http-exchange/resources/sql/fortunes
new file mode 100644
index 000000000..7446ab0c5
--- /dev/null
+++ b/frameworks/ring-http-exchange/resources/sql/fortunes
@@ -0,0 +1 @@
+SELECT id, message FROM fortune
diff --git a/frameworks/ring-http-exchange/src/ring/core.clj b/frameworks/ring-http-exchange/src/ring/core.clj
index 822237a25..497e650ec 100644
--- a/frameworks/ring-http-exchange/src/ring/core.clj
+++ b/frameworks/ring-http-exchange/src/ring/core.clj
@@ -2,13 +2,17 @@
(:require [clojure.core.cache :as cache]
[clojure.java.io :as io]
[clojure.string :as str]
- [jj.sql.boa :as boa]
- [jj.sql.boa.query.next-jdbc :refer [->NextJdbcAdapter]]
- [jj.tassu :refer [GET POST PUT route]]
+ [jj.majavat :as majavat]
+ [jj.majavat.renderer :as renderer]
+ [jj.sql.async-boa :as boa]
+ [jj.sql.boa.query.vertx-pg :as vertx-adapter]
+ [jj.tassu :refer [GET POST PUT async-route]]
[jsonista.core :as json]
[ring-http-exchange.core :as server]
[ring-http-exchange.ssl :as ssl])
- (:import (com.zaxxer.hikari HikariConfig HikariDataSource)
+ (:import (io.vertx.core Vertx)
+ (io.vertx.pgclient PgBuilder PgConnectOptions)
+ (io.vertx.sqlclient PoolOptions)
(java.io ByteArrayOutputStream FileInputStream InputStream OutputStream)
(java.net URI)
(java.security KeyStore PEMDecoder PrivateKey)
@@ -17,10 +21,11 @@
(java.util.zip GZIPOutputStream))
(:gen-class))
-(def default-executor (Executors/newVirtualThreadPerTaskExecutor))
+(def default-executor (Executors/newCachedThreadPool))
(def ^:private ^:const ct-json "application/json")
(def ^:private ^:const ct-text "text/plain")
+(def ^:private ^:const ct-html "text/html; charset=utf-8")
(def ^:private ^:const ct-octet "application/octet-stream")
(def ^:private ^:const hdr-ct "Content-Type")
(def ^:private ^:const hdr-ce "Content-Encoding")
@@ -44,16 +49,20 @@
(def ^:private ^:const tls-cert-default "/certs/server.crt")
(def ^:private ^:const tls-key-default "/certs/server.key")
-(def ^:private json-headers {hdr-ct ct-json hdr-server server-name})
+(def ^:private json-headers {hdr-ct ct-json hdr-server server-name})
(def ^:private json-gzip-headers {hdr-ct ct-json hdr-ce enc-gzip hdr-server server-name})
-(def ^:private text-headers {hdr-ct ct-text hdr-server server-name})
-
-(def ^:private pg-query (boa/build-query (->NextJdbcAdapter) "sql/pg-query"))
-(def ^:private crud-list-query (boa/build-query (->NextJdbcAdapter) "sql/crud-list"))
-(def ^:private crud-read-query (boa/build-query (->NextJdbcAdapter) "sql/crud-read"))
-(def ^:private crud-create-query (boa/build-query (->NextJdbcAdapter) "sql/crud-create"))
-(def ^:private crud-update-query (boa/build-query (->NextJdbcAdapter) "sql/crud-update"))
+(def ^:private text-headers {hdr-ct ct-text hdr-server server-name})
+(def ^:private html-headers {hdr-ct ct-html hdr-server server-name})
+(def ^:private adapter (vertx-adapter/->VertxPgAdapter))
+(def ^:private pg-query (boa/build-async-query adapter "sql/pg-query"))
+(def ^:private crud-list-query (boa/build-async-query adapter "sql/crud-list"))
+(def ^:private crud-read-query (boa/build-async-query adapter "sql/crud-read"))
+(def ^:private crud-create-query (boa/build-async-query adapter "sql/crud-create"))
+(def ^:private crud-update-query (boa/build-async-query adapter "sql/crud-update"))
+(def ^:private fortunes-query (boa/build-async-query adapter "sql/fortunes"))
+(def ^:private fortunes-render (majavat/build-html-renderer "fortunes.html"
+ {:renderer (renderer/->InputStreamRenderer)}))
(def ^:private ^:const extension-map
@@ -88,7 +97,7 @@
(persistent! m)
(let [amp (.indexOf qs (int \&) i)
end (if (neg? amp) (.length qs) amp)
- eq (.indexOf qs (int \=) i)]
+ eq (.indexOf qs (int \=) i)]
(if (and (>= eq 0) (< eq end))
(recur (inc end) (assoc! m (subs qs i eq) (subs qs (inc eq) end)))
(recur (inc end) m)))))))
@@ -101,7 +110,7 @@
total-sum
(let [amp (.indexOf qs (int \&) i)
end (if (neg? amp) (.length qs) amp)
- eq (.indexOf qs (int \=) i)]
+ eq (.indexOf qs (int \=) i)]
(if (and (>= eq 0) (< eq end))
(recur (inc end)
(+ total-sum
@@ -110,7 +119,7 @@
(defn- gzip-bytes [^bytes data]
(let [baos (ByteArrayOutputStream. (alength data))
- gos (GZIPOutputStream. baos)]
+ gos (GZIPOutputStream. baos)]
(.write gos data)
(.close gos)
(.toByteArray baos)))
@@ -130,7 +139,7 @@
(defn- get-content-type [^String name]
(let [dot-index (.lastIndexOf name ^String dot)
- ext (if (>= dot-index 0) (subs name dot-index) "")]
+ ext (if (>= dot-index 0) (subs name dot-index) "")]
(get extension-map ext ct-octet)))
(defn- transform-pg-row [row]
@@ -144,11 +153,11 @@
:rating {:score (:rating_score row) :count (:rating_count row)}})
(defn- pem->keystore [^String cert-path ^String key-path]
- (let [certs (with-open [in (FileInputStream. cert-path)]
- (.generateCertificates (CertificateFactory/getInstance "X.509") in))
- cert-array (into-array Certificate certs)
+ (let [certs (with-open [in (FileInputStream. cert-path)]
+ (.generateCertificates (CertificateFactory/getInstance "X.509") in))
+ cert-array (into-array Certificate certs)
private-key ^PrivateKey (.decode (PEMDecoder/of) ^String (slurp key-path) PrivateKey)
- password (char-array 0)]
+ password (char-array 0)]
(doto (KeyStore/getInstance "PKCS12")
(.load nil password)
(.setKeyEntry "server" private-key password cert-array))))
@@ -156,7 +165,7 @@
(defn- load-ssl-context
[]
(let [cert-path (or (System/getenv "TLS_CERT") tls-cert-default)
- key-path (or (System/getenv "TLS_KEY") tls-key-default)]
+ key-path (or (System/getenv "TLS_KEY") tls-key-default)]
(if (and (.exists (io/file cert-path)) (.exists (io/file key-path)))
(try
(ssl/keystore->ssl-context (pem->keystore cert-path key-path) "")
@@ -174,6 +183,7 @@
([handler port ssl-context]
(let [opts (cond-> {:port port
:lazy-request-map? true
+ :async? true
:executor default-executor}
ssl-context (assoc :ssl-context ssl-context))]
(try
@@ -183,61 +193,80 @@
(println (str "Failed to start server on port " port
": " (.getMessage e))))))))
-(defn- init-postgres []
+(defn- init-pg-pool []
(when-let [url (System/getenv "DATABASE_URL")]
(try
- (let [uri (URI. (str/replace url pg-prefix pg-replace))
- host (.getHost uri)
- port (if (pos? (.getPort uri)) (.getPort uri) 5432)
- db (subs (.getPath uri) 1)
+ (let [uri (URI. (str/replace url pg-prefix pg-replace))
+ host (.getHost uri)
+ port (if (pos? (.getPort uri)) (.getPort uri) 5432)
+ db (subs (.getPath uri) 1)
[user pass] (str/split (.getUserInfo uri) #":" 2)
max-conn (safe-parse-int (System/getenv "DATABASE_MAX_CONN") 256)
- cfg (doto (HikariConfig.)
- (.setJdbcUrl (str "jdbc:postgresql://" host ":" port "/" db))
- (.setUsername user)
- (.setPassword (or pass ""))
- (.setMaximumPoolSize max-conn))]
- (HikariDataSource. cfg))
- (catch Exception _ nil))))
-
-(defn- handle-baseline-get [req]
- (text-response (sum-params (:query-string req))))
-
-(defn- handle-baseline-post [req]
+ connect-opts (-> (PgConnectOptions.)
+ (.setHost host)
+ (.setPort port)
+ (.setDatabase db)
+ (.setUser user)
+ (.setPassword (or pass "")))
+ pool-opts (-> (PoolOptions.) (.setMaxSize max-conn))
+ vertx (Vertx/vertx)]
+ (-> (PgBuilder/pool)
+ (.with pool-opts)
+ (.connectingTo connect-opts)
+ (.using vertx)
+ (.build)))
+ (catch Throwable t
+ (println (str "PG init failed: " (.getMessage t)))
+ nil))))
+
+(defn- handle-baseline-get [req respond _raise]
+ (respond (text-response (sum-params (:query-string req)))))
+
+(defn- handle-baseline-post [req respond _raise]
(let [s (sum-params (:query-string req))
b (slurp (:body req))
n (safe-parse-long (str/trim b) 0)]
- (text-response (+ s n))))
-
-(defn- handle-json [dataset req]
- (let [requested (safe-parse-long (get-in req [:params :count]) 50)
- n (min requested (long (clojure.core/count dataset)))
- params (parse-qs (:query-string req))
- m (safe-parse-long (get params param-m) 1)
- items (map #(process-item % m) (subvec dataset 0 n))
+ (respond (text-response (+ s n)))))
+
+(defn- handle-json [dataset req respond _raise]
+ (let [requested (safe-parse-long (get-in req [:params :count]) 50)
+ n (min requested (long (clojure.core/count dataset)))
+ params (parse-qs (:query-string req))
+ m (safe-parse-long (get params param-m) 1)
+ items (map #(process-item % m) (subvec dataset 0 n))
body-bytes (json/write-value-as-bytes
{:items items :count (clojure.core/count items)})]
- (if (accepts-gzip? (:headers req))
- {:status 200 :headers json-gzip-headers :body (gzip-bytes body-bytes)}
- {:status 200 :headers json-headers :body (String. ^bytes body-bytes)})))
+ (respond
+ (if (accepts-gzip? (:headers req))
+ {:status 200 :headers json-gzip-headers :body (gzip-bytes body-bytes)}
+ {:status 200 :headers json-headers :body (String. ^bytes body-bytes)}))))
-(defn- handle-upload [req]
+(defn- handle-upload [req respond _raise]
(with-open [^InputStream in (:body req)]
- (text-response (.transferTo in (OutputStream/nullOutputStream)))))
+ (respond (text-response (.transferTo in (OutputStream/nullOutputStream))))))
-(defn- query-pg-items [ds params]
- (try (mapv transform-pg-row (pg-query ds params))
- (catch Exception _ [])))
-
-(defn- handle-pg [ds req]
+(defn- handle-pg [pg-pool req respond _raise]
(let [params (parse-qs (:query-string req))
- min-p (safe-parse-double (get params param-min) 10.0)
- max-p (safe-parse-double (get params param-max) 50.0)
- limit (safe-parse-long (get params param-limit) 50)
- items (query-pg-items ds {:min min-p :max max-p :limit limit})]
- (json-response {:items items :count (clojure.core/count items)})))
-
-(def ^:private crud-hit-headers {hdr-ct ct-json hdr-server server-name "X-Cache" "HIT"})
+ min-p (safe-parse-double (get params param-min) 10.0)
+ max-p (safe-parse-double (get params param-max) 50.0)
+ limit (safe-parse-long (get params param-limit) 50)]
+ (pg-query pg-pool {:min min-p :max max-p :limit limit}
+ (fn [rows]
+ (let [items (mapv transform-pg-row rows)]
+ (respond (json-response {:items items :count (count items)}))))
+ (fn [_]
+ (respond (json-response {:items [] :count 0}))))))
+
+(defn- handle-fortunes [pg-pool respond raise]
+ (fortunes-query
+ pg-pool
+ (fn [rows]
+ (let [fortunes (sort-by :message (conj (vec rows) {:id 0 :message "Additional fortune added at request time."}))
+ body (fortunes-render {:fortunes fortunes})]
+ (respond {:status 200 :headers html-headers :body body})))
+ raise))
+
+(def ^:private crud-hit-headers {hdr-ct ct-json hdr-server server-name "X-Cache" "HIT"})
(def ^:private crud-miss-headers {hdr-ct ct-json hdr-server server-name "X-Cache" "MISS"})
(def crud-cache (atom (cache/ttl-cache-factory {} :ttl 200)))
@@ -264,83 +293,105 @@
:tags (json/read-value (str (:tags row)))
:rating {:score (long (:rating_score row)) :count (long (:rating_count row))}})
-(defn- handle-crud-list [ds req]
- (let [params (parse-qs (:query-string req))
+(defn- handle-crud-list [pg-pool req respond raise]
+ (let [params (parse-qs (:query-string req))
category (or (get params "category") "electronics")
- page (max 1 (safe-parse-long (get params "page") 1))
- limit (max 1 (min 50 (safe-parse-long (get params "limit") 10)))
- offset (* (dec page) limit)
- rows (crud-list-query ds {:category category :limit limit :offset offset})
- items (mapv transform-crud-row rows)]
- (json-response {:items items :total (count items) :page page :limit limit})))
-
-(defn- handle-crud-read [ds req]
+ page (max 1 (safe-parse-long (get params "page") 1))
+ limit (max 1 (min 50 (safe-parse-long (get params "limit") 10)))
+ offset (* (dec page) limit)]
+ (crud-list-query pg-pool {:category category :limit limit :offset offset}
+ (fn [rows]
+ (let [items (mapv transform-crud-row rows)]
+ (respond (json-response {:items items
+ :total (count items)
+ :page page
+ :limit limit}))))
+ raise)))
+
+(defn- handle-crud-read [pg-pool req respond raise]
(let [id (safe-parse-long (get-in req [:params :id]) nil)]
(if (nil? id)
- {:status 404 :headers json-headers :body not-found-body}
+ (respond {:status 404 :headers json-headers :body not-found-body})
(if-let [cached (crud-cache-get id)]
- {:status 200 :headers crud-hit-headers :body cached}
- (if-let [row (first (crud-read-query ds {:id id}))]
- (let [json-str (json/write-value-as-string (transform-crud-row row))]
- (crud-cache-set id json-str)
- {:status 200 :headers crud-miss-headers :body json-str})
- {:status 404 :headers json-headers :body not-found-body})))))
-
-(defn- handle-crud-create [ds req]
- (let [body (json/read-value (:body req) json/keyword-keys-object-mapper)
- id (:id body)
- nm (or (:name body) "New Product")
+ (respond {:status 200 :headers crud-hit-headers :body cached})
+ (crud-read-query pg-pool {:id id}
+ (fn [rows]
+ (if-let [row (first rows)]
+ (let [json-str (json/write-value-as-string (transform-crud-row row))]
+ (crud-cache-set id json-str)
+ (respond {:status 200 :headers crud-miss-headers :body json-str}))
+ (respond {:status 404 :headers json-headers :body not-found-body})))
+ raise)))))
+
+(defn- handle-crud-create [pg-pool req respond raise]
+ (let [body (json/read-value (:body req) json/keyword-keys-object-mapper)
+ id (:id body)
+ nm (or (:name body) "New Product")
category (or (:category body) "test")
- price (or (:price body) 0)
- quantity (or (:quantity body) 0)
- result (first (crud-create-query ds {:id id :name nm :category category :price price :quantity quantity}))]
- {:status 201
- :headers json-headers
- :body (json/write-value-as-string {:id (:id result) :name nm :category category :price price :quantity quantity})}))
-
-(defn- handle-crud-update [ds req]
+ price (or (:price body) 0)
+ quantity (or (:quantity body) 0)]
+ (crud-create-query pg-pool {:id id :name nm :category category :price price :quantity quantity}
+ (fn [rows]
+ (respond {:status 201
+ :headers json-headers
+ :body (json/write-value-as-string
+ {:id (:id (first rows))
+ :name nm
+ :category category
+ :price price
+ :quantity quantity})}))
+ raise)))
+
+(defn- handle-crud-update [pg-pool req respond raise]
(let [id (safe-parse-long (get-in req [:params :id]) nil)]
(if (nil? id)
- {:status 404 :headers json-headers :body not-found-body}
- (let [body (json/read-value (:body req) json/keyword-keys-object-mapper)
- nm (or (:name body) "Updated")
- price (or (:price body) 0)
- quantity (or (:quantity body) 0)
- result (first (crud-update-query ds {:name nm :price price :quantity quantity :id id}))]
- (if (and result (pos? (or (:next.jdbc/update-count result) 0)))
- (do
- (crud-cache-evict id)
- {:status 200
- :headers json-headers
- :body (json/write-value-as-string {:id id :name nm :price price :quantity quantity})})
- {:status 404 :headers json-headers :body not-found-body})))))
-
-(defn- handle-static [req]
+ (respond {:status 404 :headers json-headers :body not-found-body})
+ (let [body (json/read-value (:body req) json/keyword-keys-object-mapper)
+ nm (or (:name body) "Updated")
+ price (or (:price body) 0)
+ quantity (or (:quantity body) 0)]
+ (crud-update-query pg-pool {:name nm :price price :quantity quantity :id id}
+ (fn [rows]
+ (if (seq rows)
+ (do
+ (crud-cache-evict id)
+ (respond {:status 200
+ :headers json-headers
+ :body (json/write-value-as-string
+ {:id id
+ :name nm
+ :price price
+ :quantity quantity})}))
+ (respond {:status 404 :headers json-headers :body not-found-body})))
+ raise)))))
+
+(defn- handle-static [req respond _raise]
(let [name (get-in req [:params :filename])
- f (io/file static-dir name)]
+ f (io/file static-dir name)]
(if (.exists f)
- {:status 200
- :headers {hdr-ct (get-content-type name) hdr-server server-name}
- :body f}
- {:status 404 :body not-found-body})))
-
-(defn- build-handler [{:keys [dataset pg-ds]}]
- (route
- {"/baseline11" [(GET handle-baseline-get)
+ (respond {:status 200
+ :headers {hdr-ct (get-content-type name) hdr-server server-name}
+ :body f})
+ (respond {:status 404 :body not-found-body}))))
+
+(defn- build-handler [{:keys [dataset pg-pool]}]
+ (async-route
+ {"/baseline11" [(GET handle-baseline-get)
(POST handle-baseline-post)]
- "/json/:count" [(GET (fn [req] (handle-json dataset req)))]
+ "/json/:count" [(GET (fn [req res rej] (handle-json dataset req res rej)))]
"/upload" [(POST handle-upload)]
- "/async-db" [(GET (fn [req] (handle-pg pg-ds req)))]
- "/crud/items" [(GET (fn [req] (handle-crud-list pg-ds req)))
- (POST (fn [req] (handle-crud-create pg-ds req)))]
- "/crud/items/:id" [(GET (fn [req] (handle-crud-read pg-ds req)))
- (PUT (fn [req] (handle-crud-update pg-ds req)))]
- "/static/:filename" [(GET handle-static)]
- "/" [(GET (fn [_] (text-response server-name)))]}))
+ "/async-db" [(GET (fn [req res rej] (handle-pg pg-pool req res rej)))]
+ "/fortunes" [(GET (fn [_ res rej] (handle-fortunes pg-pool res rej)))]
+ "/crud/items" [(GET (fn [req res rej] (handle-crud-list pg-pool req res rej)))
+ (POST (fn [req res rej] (handle-crud-create pg-pool req res rej)))]
+ "/crud/items/:id" [(GET (fn [req res rej] (handle-crud-read pg-pool req res rej)))
+ (PUT (fn [req res rej] (handle-crud-update pg-pool req res rej)))]
+ "/static/:filename" [(GET handle-static)]
+ "/" [(GET (fn [_ res _] (res (text-response server-name))))]}))
(defn -main [& _]
- (let [dataset (load-json (or (System/getenv "DATASET_PATH") dataset-path))
- handler (build-handler {:dataset dataset
- :pg-ds (init-postgres)})]
+ (let [dataset (load-json (or (System/getenv "DATASET_PATH") dataset-path))
+ handler (build-handler {:dataset dataset
+ :pg-pool (init-pg-pool)})]
(start-server! handler plain-port)
(start-server! handler tls-port (load-ssl-context))))
\ No newline at end of file