Beta use pgwire for sql

fixes #42 fixes #19 Handle vector row results Move data manipulation to server Remove beta button Add beta banner Add more logging Handle todos Add handler tests Refactor Reorg file structure Stop shadowing clojure.core/list Refactor Re-frame improvements fixes #44 Add cljs run test Tidy up Fix query not updating Fix nested data formats Stay backwards compatible for docs Remove confusing system time abstraction Tidy up Fix mobile footer and unstick non-mobile header Standardise where we update-url on editor updates Add update url interval Make cljs config more config Fix cljs tests
xtdb · Dec 10, 2024 · 217e751 · 217e751
1 parent 2fa8501
commit 217e751
Show file tree

Hide file tree

Showing 32 changed files with 1,138 additions and 585 deletions.
diff --git a/.gitignore b/.gitignore
@@ -1,3 +1,4 @@
+*~
 .cpcache
 .nrepl-port
 target

diff --git a/deps.edn b/deps.edn
@@ -1,4 +1,4 @@
-{:paths ["src/clj" "resources"]
+{:paths ["src/clj" "src/cljc" "resources"]
 
  :deps
  {org.clojure/clojure {:mvn/version "1.12.0"}
@@ -7,6 +7,9 @@
   com.xtdb/xtdb-api {:mvn/version "2.0.0-beta3"}
   com.xtdb/xtdb-core {:mvn/version "2.0.0-beta3"}
 
+  org.postgresql/postgresql {:mvn/version "42.7.4"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.3.939"}
+
   ;; Lambda
   com.amazonaws/aws-lambda-java-core {:mvn/version "1.2.3"}
 

diff --git a/shadow-cljs.edn b/shadow-cljs.edn
@@ -11,10 +11,14 @@
  :nrepl {:middleware [cider.nrepl/cider-middleware
                       refactor-nrepl.middleware/wrap-refactor]}
 
- :dev-http {8020 "resources/public"}
+ :dev-http {8020 "resources/public"
+            8021 "out/test"}
 
  :builds
- {:app
+ {:test
+  {:target :browser-test
+   :test-dir "out/test"}
+  :app
   {:target     :browser
 
    :modules {:app {:entries [xt-play.app]}}

diff --git a/src/clj/xt_play/config.clj b/src/clj/xt_play/config.clj
@@ -0,0 +1,9 @@
+(ns xt-play.config)
+
+(def db
+  {:dbtype "postgresql"
+   :dbname "xtdb"
+   :user "xtdb"
+   :password "xtdb"
+   :host "localhost"
+   :port 5432})
diff --git a/src/clj/xt_play/handler.clj b/src/clj/xt_play/handler.clj
@@ -1,28 +1,48 @@
 (ns xt-play.handler
-  (:require [integrant.core :as ig]
-            [clojure.edn :as edn]
-            [clojure.instant :refer [read-instant-date]]
-            [clojure.spec.alpha :as s]
+  (:require [clojure.spec.alpha :as s]
             [clojure.tools.logging :as log]
+            [integrant.core :as ig]
             [muuntaja.core :as m]
             [reitit.coercion.spec :as rcs]
             [reitit.dev.pretty :as pretty]
             [reitit.ring :as ring]
             [reitit.ring.coercion :as rrc]
             [reitit.ring.middleware.exception :as exception]
             [reitit.ring.middleware.muuntaja :as muuntaja]
+            [ring.middleware.cors :refer [wrap-cors]]
             [ring.middleware.params :as params]
             [ring.util.response :as response]
-            [ring.middleware.cors :refer [wrap-cors]]
-            [xtdb.api :as xt]
-            [xtdb.node :as xtn]
-            [hiccup.page :as h]))
+            [xt-play.transactions :as txs]
+            [xt-play.view :as view]))
+
+;; TODO:
+;; [x] Send tx data back asis - data manipulation server side
+;; [x] Beta is an option in the type
+;; [x] Handle multi tx on pgwire
+;; [x] Handle system time on pgwire
+;; [x] Manipulate response data server side
+;; [x] remove btn
+;; [x] banner
+;; [x] logging
+;; [x] handle todos
+;; [x] Tests!
+;; [x] Refactor - split into more meaningful files
+;; [x] - add config, request, response, xt ns
+;; [x] - split out ui to components
+;; [x] - Better management on subs
+;; [x] cljs tests
+;; [] Handle queries in tx?
+;; [] Display errors in result box
+;; [] automated test runners / pipelines
+;; [] extract common tailwind classes, e.g. icon sizes, to standardize
 
 (s/def ::system-time (s/nilable string?))
 (s/def ::txs string?)
 (s/def ::tx-batches (s/coll-of (s/keys :req-un [::system-time ::txs])))
 (s/def ::query string?)
+(s/def ::tx-type #{"sql-beta" "xtql" "sql"})
 (s/def ::db-run (s/keys :req-un [::tx-batches ::query]))
+(s/def ::beta-db-run (s/keys :req-un [::tx-batches ::query ::tx-type]))
 
 (defn- handle-client-error [ex _]
   {:status 400
@@ -45,85 +65,40 @@
      clojure.lang.ExceptionInfo handle-client-error
      ::exception/default handle-other-error})))
 
-(def xt-version
-  (-> (slurp "deps.edn")
-      (edn/read-string)
-      (get-in [:deps 'com.xtdb/xtdb-core :mvn/version])))
-(assert (string? xt-version) "xt-version not present")
-
-(def index
-  (h/html5
-   [:head
-    [:meta {:charset "utf-8"}]
-    [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}]
-    [:meta {:name "description" :content ""}]
-    [:link {:rel "stylesheet" :href "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/styles/default.min.css"}]
-    [:link {:rel "stylesheet" :type "text/css" :href "/public/css/main.css"}]
-    [:script {:src "https://cdn.tailwindcss.com"}]
-    [:script {:async true
-              :defer true
-              :data-website-id "aabeabcb-ad76-47a4-9b4b-bef3fdc39af4"
-              :src "https://bunseki.juxt.pro/umami.js"}]
-    [:title "XTDB Play"]]
-   [:body
-    [:div {:id "app"}]
-    [:script {:type "text/javascript" :src "/public/js/compiled/app.js"}]
-    [:script {:type "text/javascript"}
-     (str "var xt_version = '" xt-version "';")]
-    [:script {:type "text/javascript"}
-     "xt_play.app.init()"]]))
-
-
-(comment
-  (with-open [node (xtn/start-node {})]
-    (doseq [st [#inst "2022" #inst "2021"]]
-      (let [tx (xt/submit-tx node [] {:system-time st})
-            results (xt/q node '(from :xt/txs [{:xt/id $tx-id} xt/error])
-                          {:basis {:at-tx tx}
-                           :args {:tx-id (:tx-id tx)}})]
-        (when-let [error (-> results first :xt/error)]
-          (throw (ex-info "Transaction error" {:error error})))))))
-
-(defn run-handler [request]
+(defn run-handler [{{body :body} :parameters :as request}]
   (log/debug "run-handler" request)
-  (let [{:keys [tx-batches query]} (get-in request [:parameters :body])
-        ;; TODO: Filter for only the readers required?
-        read-edn (partial edn/read-string {:readers *data-readers*})
-        tx-batches (->> tx-batches
-                        (map #(update % :system-time (fn [s] (when s (read-instant-date s)))))
-                        (map #(update % :txs read-edn)))
-        query (read-edn query)]
-    (log/info :db-run {:tx-batches tx-batches :query query})
-    (try
-      (with-open [node (xtn/start-node {})]
-        ;; Run transactions
-        (doseq [{:keys [system-time txs]} tx-batches]
-          (let [tx (xt/submit-tx node txs {:system-time system-time})
-                results (xt/q node '(from :xt/txs [{:xt/id $tx-id} xt/error])
-                              {:args {:tx-id (:tx-id tx)}})]
-            ;; If any transaction fails, throw the error
-            (when-let [error (-> results first :xt/error)]
-              (throw error))))
-        ;; Run query
-        (let [res (xt/q node query (when (string? query)
-                                     {:key-fn :snake-case-string}))]
-          {:status 200
-           :body res}))
-      (catch Exception e
-        (log/warn :submit-error {:e e})
-        (throw e)))))
+  (log/info :db-run body)
+  (if-let [result (txs/run!! body)]
+    {:status 200
+     :body result}
+    {:status 400}))
+
+(defn docs-run-handler [{{body :body} :parameters :as request}]
+  (log/debug "docs-run-handler" request)
+  (log/info :docs-db-run body)
+  (if-let [result (txs/docs-run!! body)]
+    {:status 200
+     :body result}
+    {:status 400}))
 
 (def routes
   (ring/router
    [["/"
      {:get {:summary "Fetch main page"
             :handler (fn [_request]
-                       (-> (response/response index)
+                       (-> (response/response view/index)
                            (response/content-type "text/html")))}}]
 
-    ["/db-run"
+    ["/db-run" ;; if the contract for this changes, it'll break the docs, so
+     ;; either docs need to change, or needs to remain backward
+     ;; compatible
      {:post {:summary "Run transactions + a query"
              :parameters {:body ::db-run}
+             :handler #'docs-run-handler}}]
+
+    ["/beta-db-run"
+     {:post {:summary "Run transactions + a query"
+             :parameters {:body ::beta-db-run}
              :handler #'run-handler}}]
 
     ["/public/*" (ring/create-resource-handler)]]

diff --git a/src/clj/xt_play/transactions.clj b/src/clj/xt_play/transactions.clj
@@ -0,0 +1,117 @@
+(ns xt-play.transactions
+  (:require [clojure.string :as str]
+            [clojure.data.json :as json]
+            [clojure.instant :refer [read-instant-date]]
+            [clojure.tools.logging :as log]
+            [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as jdbc-res]
+            [xt-play.config :as config]
+            [xt-play.util :as util]
+            [xtdb.api :as xt]
+            [xtdb.node :as xtn]))
+
+(defn- encode-txs [tx-type txs]
+  (case (keyword tx-type)
+    :sql (->> (str/split txs #";")
+              (remove str/blank?)
+              (map #(do [:sql %]))
+              (vec))
+    :xtql (util/read-edn (str "[" txs "]"))
+    ;;else
+    txs))
+
+(defn- prepare-statements
+  "Takes a batch of transactions and prepares the jdbc execution args to
+  be run sequentially"
+  [tx-batches]
+  (for [{:keys [txs system-time]} tx-batches]
+    (remove nil?
+     [(when system-time
+        [(format "BEGIN AT SYSTEM_TIME TIMESTAMP '%s'" system-time)])
+      [txs]
+      (when system-time
+        ["COMMIT"])])))
+
+(defn format-system-time [s]
+  (when s (read-instant-date s)))
+
+(defn- run!-tx [node tx-type tx-batches query]
+  (let [tx-batches (->> tx-batches
+                        (map #(update % :system-time format-system-time))
+                        (map #(update % :txs (partial encode-txs tx-type))))]
+    (doseq [{:keys [system-time txs] :as batch} tx-batches]
+      (log/info tx-type "running batch: " batch)
+      (let [tx (xt/submit-tx node txs {:system-time system-time})
+            results (xt/q node '(from :xt/txs [{:xt/id $tx-id} xt/error])
+                          {:args {:tx-id (:tx-id tx)}})]
+        ;; If any transaction fails, throw the error
+        (log/info tx-type "batch complete:" tx ", results:" results)
+        (when-let [error (-> results first :xt/error)]
+          (throw error)))))
+  (log/info tx-type "running query:" query)
+  (let [res (xt/q node query (when (string? query)
+                               {:key-fn :snake-case-string}))]
+    (log/info tx-type "XTDB query response:" res)
+    res))
+
+(defn- PGobject->clj [v]
+  (if (= org.postgresql.util.PGobject (type v))
+    (json/read-str (.getValue v) :key-fn keyword)
+    v))
+
+(defn- parse-result [result]
+  ;; TODO - this shouldn't be needed, a fix is on the way in
+  ;;        a later version of xtdb-jdb
+  ;; This will only pick up top level objects
+  (mapv
+   (fn [row]
+     (mapv PGobject->clj row))
+   result))
+
+(defn- run!-with-jdbc-conn [tx-batches query]
+  (with-open [conn (jdbc/get-connection config/db)]
+    (doseq [tx (prepare-statements tx-batches)
+            statement tx]
+      (log/info "beta executing statement:" statement)
+      (jdbc/execute! conn statement))
+    (log/info "beta running query:" query)
+    (let [res (jdbc/execute! conn [query] {:builder-fn jdbc-res/as-arrays})]
+      (log/info "beta query resoponse" res)
+      (parse-result res))))
+
+(defn run!!
+  "Given transaction batches, a query and the type of transaction to
+  use, will run transaction batches and queries sequentially,
+  returning the last query response in column format."
+  [{:keys [tx-batches query tx-type]}]
+  (let [query (if (= "xtql" tx-type) (util/read-edn query) query)]
+    (try
+      (with-open [node (xtn/start-node {})]
+        (if (= "sql-beta" tx-type)
+          (run!-with-jdbc-conn tx-batches query)
+          (util/map-results->rows
+           (run!-tx node tx-type tx-batches query))))
+      (catch Exception e
+        (log/warn :submit-error {:e e})
+        (throw e)))))
+
+(defn docs-run!!
+  "Given transaction batches and a query from the docs, will return the query
+  response in map format. Assumes tx type is sql."
+  [{:keys [tx-batches query]}]
+  (try
+    (with-open [node (xtn/start-node {})]
+      (run!-tx node "sql" tx-batches query))
+    (catch Exception e
+      (log/warn :submit-error {:e e})
+      (throw e))))
+
+(comment
+  (with-open [node (xtn/start-node {})]
+    (doseq [st [#inst "2022" #inst "2021"]]
+      (let [tx (xt/submit-tx node [] {:system-time st})
+            results (xt/q node '(from :xt/txs [{:xt/id $tx-id} xt/error])
+                          {:basis {:at-tx tx}
+                           :args {:tx-id (:tx-id tx)}})]
+        (when-let [error (-> results first :xt/error)]
+          (throw (ex-info "Transaction error" {:error error})))))))
diff --git a/src/clj/xt_play/view.clj b/src/clj/xt_play/view.clj
@@ -0,0 +1,31 @@
+(ns xt-play.view
+  (:require [hiccup.page :as h]
+            [xt-play.util :as util]))
+
+(def index
+  (h/html5
+   [:head
+    [:meta {:charset "utf-8"}]
+    [:meta {:name "viewport"
+            :content "width=device-width, initial-scale=1"}]
+    [:meta {:name "description"
+            :content ""}]
+    [:link {:rel "stylesheet"
+            :href "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/styles/default.min.css"}]
+    [:link {:rel "stylesheet"
+            :type "text/css"
+            :href "/public/css/main.css"}]
+    [:script {:src "https://cdn.tailwindcss.com"}]
+    [:script {:async true
+              :defer true
+              :data-website-id "aabeabcb-ad76-47a4-9b4b-bef3fdc39af4"
+              :src "https://bunseki.juxt.pro/umami.js"}]
+    [:title "XTDB Play"]]
+   [:body
+    [:div {:id "app"}]
+    [:script {:type "text/javascript"
+              :src "/public/js/compiled/app.js"}]
+    [:script {:type "text/javascript"}
+     (str "var xt_version = '" util/xt-version "';")]
+    [:script {:type "text/javascript"}
+     "xt_play.app.init()"]]))
diff --git a/src/cljc/xt_play/util.cljc b/src/cljc/xt_play/util.cljc
@@ -0,0 +1,20 @@
+(ns xt-play.util
+  (:require #?(:clj [clojure.edn :as edn])))
+
+#?(:clj
+   (def xt-version
+     (-> (slurp "deps.edn")
+         (edn/read-string)
+         (get-in [:deps 'com.xtdb/xtdb-core :mvn/version]))))
+
+#?(:clj
+   (def read-edn
+     (partial edn/read-string {:readers *data-readers*})))
+
+(defn map-results->rows
+  [results]
+  (let [ks (keys (apply merge results))]
+    (into [(vec ks)]
+          (mapv (fn [row]
+                  (mapv #(get row %) ks))
+                results))))