From e2065f9e52fee3cdf67dc5d655251bc984e7a587 Mon Sep 17 00:00:00 2001 From: modality Date: Thu, 26 May 2022 17:56:47 +0100 Subject: [PATCH 01/33] mysql connector --- deps.edn | 1 + 1 file changed, 1 insertion(+) diff --git a/deps.edn b/deps.edn index c36cc73ac..72cc72e7b 100644 --- a/deps.edn +++ b/deps.edn @@ -14,6 +14,7 @@ com.xtdb/xtdb-lucene {:mvn/version "1.20.0"} com.xtdb/xtdb-http-server {:mvn/version "1.20.0"} com.xtdb/xtdb-jdbc {:mvn/version "1.20.0"} + mysql/mysql-connector-java {:mvn/version "8.0.23"} ;; Jetty From 056c61c1b3003494e9bc57b382fa2618679c4114 Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 1 Jun 2022 09:14:04 +0100 Subject: [PATCH 02/33] import-resources idempotent --- src/juxt/site/alpha/repl.clj | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index ed228ba95..11bb1833a 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -179,17 +179,21 @@ :else nil))) + (defn import-resources ([] (import-resources "import/resources.edn")) ([filename] - (let [node (xt-node) - in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] - (doseq [rec (resources-from-stream in)] - (println "Importing record" (:xt/id rec)) - (when (:xt/id rec) - (xt/submit-tx node [[:xtdb.api/put rec]]))) - (xt/sync node) - (println "Import finished.")))) + (let [node (xt-node)] + (if (xt/entity (xt/db (xt-node)) filename) + (println "Skipping already imported: " filename) + (let [in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] + (doseq [rec (resources-from-stream in)] + (println "Importing record" (:xt/id rec)) + (when (:xt/id rec) + (xt/submit-tx node [[:xtdb.api/put rec]]))) + (xt/submit-tx node [[:xtdb.api/put {:xt/id filename}]]) + (xt/sync node) + (println "Import finished.")))))) (defn validate-resource-line [s] (edn/read-string From c2e858c542fa46ba8738080785e0c153eb03453b Mon Sep 17 00:00:00 2001 From: modality Date: Fri, 3 Jun 2022 09:17:08 +0100 Subject: [PATCH 03/33] update dependencies --- deps.edn | 58 +++++++++++++++++++++++++++----------------------------- 1 file changed, 28 insertions(+), 30 deletions(-) diff --git a/deps.edn b/deps.edn index 72cc72e7b..acbdf79f9 100644 --- a/deps.edn +++ b/deps.edn @@ -4,28 +4,27 @@ :deps {org.clojure/clojure {:mvn/version "1.11.1"} ;; Project skeleton - also see src/config.edn - integrant/integrant {:mvn/version "0.7.0"} + integrant/integrant {:mvn/version "0.8.0"} aero/aero {:mvn/version "1.1.6"} - io.aviso/pretty {:mvn/version "0.1.35"} + io.aviso/pretty {:mvn/version "1.1.1"} ;; XT - com.xtdb/xtdb-core {:mvn/version "1.20.0"} - com.xtdb/xtdb-rocksdb {:mvn/version "1.20.0"} - com.xtdb/xtdb-lucene {:mvn/version "1.20.0"} - com.xtdb/xtdb-http-server {:mvn/version "1.20.0"} - com.xtdb/xtdb-jdbc {:mvn/version "1.20.0"} - mysql/mysql-connector-java {:mvn/version "8.0.23"} - + com.xtdb/xtdb-core {:mvn/version "1.21.0"} + com.xtdb/xtdb-rocksdb {:mvn/version "1.21.0"} + com.xtdb/xtdb-lucene {:mvn/version "1.21.0"} + com.xtdb/xtdb-http-server {:mvn/version "1.21.0"} + com.xtdb/xtdb-jdbc {:mvn/version "1.21.0"} + mysql/mysql-connector-java {:mvn/version "8.0.29"} ;; Jetty ring/ring-jetty-adapter {:mvn/version "1.9.5"} ;; Logging - org.clojure/tools.logging {:mvn/version "1.1.0"} - org.slf4j/jcl-over-slf4j {:mvn/version "1.7.30"} - org.slf4j/jul-to-slf4j {:mvn/version "1.7.30"} - org.slf4j/log4j-over-slf4j {:mvn/version "1.7.30"} - ch.qos.logback/logback-classic {:mvn/version "1.2.3" + org.clojure/tools.logging {:mvn/version "1.2.4"} + org.slf4j/jcl-over-slf4j {:mvn/version "1.7.36"} + org.slf4j/jul-to-slf4j {:mvn/version "1.7.36"} + org.slf4j/log4j-over-slf4j {:mvn/version "1.7.36"} + ch.qos.logback/logback-classic {:mvn/version "1.2.11" :exclusions [org.slf4j/slf4j-api]} ;; Content negotiation @@ -47,25 +46,25 @@ #_{:local/root "../jinx"} ;; Ring for some utility code - ring/ring-core {:mvn/version "1.9.1"} + ring/ring-core {:mvn/version "1.9.5"} ;; Passwords - crypto-password/crypto-password {:mvn/version "0.2.1"} + crypto-password/crypto-password {:mvn/version "0.3.0"} ;; Support for Representations clj-yaml/clj-yaml {:mvn/version "0.4.0"} hiccup/hiccup {:mvn/version "2.0.0-alpha2"} - metosin/jsonista {:mvn/version "0.2.7"} - json-html/json-html {:mvn/version "0.4.0"} + metosin/jsonista {:mvn/version "0.3.6"} + json-html/json-html {:mvn/version "0.4.7"} ;; Selmer templating - selmer/selmer {:mvn/version "1.12.40"} + selmer/selmer {:mvn/version "1.12.50"} ;; REPL highlighting - mvxcvi/puget {:mvn/version "1.3.1"} + mvxcvi/puget {:mvn/version "1.3.2"} ;; Time - tick/tick {:mvn/version "0.5.0-RC4"} + tick/tick {:mvn/version "0.5.0-RC5"} ;; Removing AWS means we now need a direct dependency on this jar for an ;; internal Nippy function. This is provided by later versions of XT, so @@ -80,17 +79,16 @@ ;; Required for OAuth2, not necessarily only for Auth0 since it ;; implements the relevant standards so any OAuth2 provided should work. - com.auth0/java-jwt {:mvn/version "3.18.3"} - com.auth0/jwks-rsa {:mvn/version "0.20.1"} - } + com.auth0/java-jwt {:mvn/version "3.19.2"} + com.auth0/jwks-rsa {:mvn/version "0.21.1"}} :aliases {:dev {:extra-paths ["dev" "test"] - :extra-deps { ;; Convenience libraries made available during development - org.clojure/test.check {:mvn/version "0.9.0"} + :extra-deps {;; Convenience libraries made available during development + org.clojure/test.check {:mvn/version "1.1.1"} org.clojure/alpha.spec {:git/url "https://github.com/clojure/spec-alpha2.git" - :sha "c087ded910b3532a938b37e853df79fc3b9c48c1"} + :sha "99456b1856a6fd934e2c30b17920bd790dd81775"} org.eclipse.jetty/jetty-jmx {:mvn/version "9.4.44.v20210927"}} :jvm-opts ["-XX:-OmitStackTraceInFastThrow" "-Dclojure.server.site={:port,50505,:accept,juxt.site.alpha.repl-server/repl}" @@ -99,9 +97,9 @@ :test {:extra-paths ["test"] :extra-deps - {lambdaisland/kaocha {:mvn/version "1.0.887"} + {lambdaisland/kaocha {:mvn/version "1.66.1034"} lambdaisland/kaocha-junit-xml {:mvn/version "0.0.76"} - nrepl/nrepl {:mvn/version "0.9.0-beta4"}}} + nrepl/nrepl {:mvn/version "0.9.0"}}} :prod {:extra-paths ["prod"] @@ -111,5 +109,5 @@ "-Dcom.sun.management.jmxremote.port=8001" "--illegal-access=warn"] ;; nREPL can be useful debugging prod - :extra-deps {nrepl/nrepl {:mvn/version "0.9.0-beta4"} + :extra-deps {nrepl/nrepl {:mvn/version "0.9.0"} org.eclipse.jetty/jetty-jmx {:mvn/version "9.4.44.v20210927"}}}}} From 64f3ef4a31d125f27ceef2cf4b593f403f016247 Mon Sep 17 00:00:00 2001 From: modality Date: Fri, 3 Jun 2022 09:29:40 +0100 Subject: [PATCH 04/33] fixed test, back to XTDB 1.20.0 --- deps.edn | 10 +++++----- test/juxt/site/graphql_test.clj | 7 +++---- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/deps.edn b/deps.edn index acbdf79f9..afd27be12 100644 --- a/deps.edn +++ b/deps.edn @@ -9,11 +9,11 @@ io.aviso/pretty {:mvn/version "1.1.1"} ;; XT - com.xtdb/xtdb-core {:mvn/version "1.21.0"} - com.xtdb/xtdb-rocksdb {:mvn/version "1.21.0"} - com.xtdb/xtdb-lucene {:mvn/version "1.21.0"} - com.xtdb/xtdb-http-server {:mvn/version "1.21.0"} - com.xtdb/xtdb-jdbc {:mvn/version "1.21.0"} + com.xtdb/xtdb-core {:mvn/version "1.20.0"} + com.xtdb/xtdb-rocksdb {:mvn/version "1.20.0"} + com.xtdb/xtdb-lucene {:mvn/version "1.20.0"} + com.xtdb/xtdb-http-server {:mvn/version "1.20.0"} + com.xtdb/xtdb-jdbc {:mvn/version "1.20.0"} mysql/mysql-connector-java {:mvn/version "8.0.29"} ;; Jetty diff --git a/test/juxt/site/graphql_test.clj b/test/juxt/site/graphql_test.clj index 8f6a0e66f..b15c88006 100644 --- a/test/juxt/site/graphql_test.clj +++ b/test/juxt/site/graphql_test.clj @@ -280,7 +280,8 @@ type Mutation { (is (= {:xt/id "https://example.org/persons/mal" :juxt.site/type "Person" :name "Malcolm Sparks"} - (xt/entity db "https://example.org/persons/mal")))) + (-> (xt/entity db "https://example.org/persons/mal") + (select-keys [:xt/id :juxt.site/type :name]))))) (let [body (json/read-value (:ring.response/body response))] (is (= {"data" @@ -289,9 +290,7 @@ type Mutation { "name" "Malcolm Sparks"}}} body)) ;;body - )) - - )) + )))) #_((t/join-fixtures [with-xt with-handler]) mutation From 6d1fa69c3483a4aa075649887936c2130d5013a1 Mon Sep 17 00:00:00 2001 From: modality Date: Sun, 12 Jun 2022 10:34:34 +0100 Subject: [PATCH 05/33] XT node sync tx-ingester --- src/juxt/site/alpha/db.clj | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/juxt/site/alpha/db.clj b/src/juxt/site/alpha/db.clj index d1f410b2e..ce5d2deb5 100644 --- a/src/juxt/site/alpha/db.clj +++ b/src/juxt/site/alpha/db.clj @@ -7,8 +7,14 @@ [clojure.tools.logging :as log])) (defmethod ig/init-key ::xt-node [_ xtdb-opts] - (log/info "Starting XT node") - (xt/start-node xtdb-opts)) + (log/info "Starting XT node...") + (xt/start-node xtdb-opts) + ;; we need to make sure the tx-ingester has caught up before + ;; declaring the node up + (xt/await-tx xtdb-opts + (xt/submit-tx xtdb-opts [[::xt/put {:xt/id :tx-ingester-synced!}]])) + (log/info "... XT node started!") + ) (defmethod ig/halt-key! ::xt-node [_ node] (.close node) From 571537bc7bd84114e81846b518646ade4f4c0aaf Mon Sep 17 00:00:00 2001 From: modality Date: Sun, 12 Jun 2022 10:58:07 +0100 Subject: [PATCH 06/33] missing coffee --- src/juxt/site/alpha/db.clj | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/juxt/site/alpha/db.clj b/src/juxt/site/alpha/db.clj index ce5d2deb5..3f5652fd4 100644 --- a/src/juxt/site/alpha/db.clj +++ b/src/juxt/site/alpha/db.clj @@ -8,13 +8,14 @@ (defmethod ig/init-key ::xt-node [_ xtdb-opts] (log/info "Starting XT node...") - (xt/start-node xtdb-opts) - ;; we need to make sure the tx-ingester has caught up before - ;; declaring the node up - (xt/await-tx xtdb-opts - (xt/submit-tx xtdb-opts [[::xt/put {:xt/id :tx-ingester-synced!}]])) - (log/info "... XT node started!") - ) + (let [node (xt/start-node xtdb-opts)] + ;; we need to make sure the tx-ingester has caught up before + ;; declaring the node up + (->> + (xt/submit-tx node [[::xt/put {:xt/id :tx-ingester-synced!}]]) + (xt/await-tx node)) + (log/info "... XT node started!") + node)) (defmethod ig/halt-key! ::xt-node [_ node] (.close node) From 4d27d0950d9d4a9d4aa588aa0aa25e7166187025 Mon Sep 17 00:00:00 2001 From: modality Date: Sun, 12 Jun 2022 11:32:10 +0100 Subject: [PATCH 07/33] spurious --- src/juxt/site/alpha/db.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/juxt/site/alpha/db.clj b/src/juxt/site/alpha/db.clj index 3f5652fd4..4d516c84e 100644 --- a/src/juxt/site/alpha/db.clj +++ b/src/juxt/site/alpha/db.clj @@ -7,7 +7,7 @@ [clojure.tools.logging :as log])) (defmethod ig/init-key ::xt-node [_ xtdb-opts] - (log/info "Starting XT node...") + (log/info "Starting XT node ...") (let [node (xt/start-node xtdb-opts)] ;; we need to make sure the tx-ingester has caught up before ;; declaring the node up From 8be52142ce931db6a8d021d035c224c1d4b38def Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 15 Jun 2022 07:57:02 +0100 Subject: [PATCH 08/33] 1.21.0 --- deps.edn | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/deps.edn b/deps.edn index afd27be12..acbdf79f9 100644 --- a/deps.edn +++ b/deps.edn @@ -9,11 +9,11 @@ io.aviso/pretty {:mvn/version "1.1.1"} ;; XT - com.xtdb/xtdb-core {:mvn/version "1.20.0"} - com.xtdb/xtdb-rocksdb {:mvn/version "1.20.0"} - com.xtdb/xtdb-lucene {:mvn/version "1.20.0"} - com.xtdb/xtdb-http-server {:mvn/version "1.20.0"} - com.xtdb/xtdb-jdbc {:mvn/version "1.20.0"} + com.xtdb/xtdb-core {:mvn/version "1.21.0"} + com.xtdb/xtdb-rocksdb {:mvn/version "1.21.0"} + com.xtdb/xtdb-lucene {:mvn/version "1.21.0"} + com.xtdb/xtdb-http-server {:mvn/version "1.21.0"} + com.xtdb/xtdb-jdbc {:mvn/version "1.21.0"} mysql/mysql-connector-java {:mvn/version "8.0.29"} ;; Jetty From aeba274eb9f291de17dd786267c4d227a145c2fa Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 15 Jun 2022 11:23:55 +0100 Subject: [PATCH 09/33] s3 store --- deps.edn | 1 + 1 file changed, 1 insertion(+) diff --git a/deps.edn b/deps.edn index acbdf79f9..3690a8dc3 100644 --- a/deps.edn +++ b/deps.edn @@ -14,6 +14,7 @@ com.xtdb/xtdb-lucene {:mvn/version "1.21.0"} com.xtdb/xtdb-http-server {:mvn/version "1.21.0"} com.xtdb/xtdb-jdbc {:mvn/version "1.21.0"} + com.xtdb/xtdb-s3 {:mvn/version "1.21.0"} mysql/mysql-connector-java {:mvn/version "8.0.29"} ;; Jetty From 469a96feecaa7a0d3d6ec00f5f107907d3c3a921 Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 15 Jun 2022 11:57:03 +0100 Subject: [PATCH 10/33] tick upd --- deps.edn | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/deps.edn b/deps.edn index 3690a8dc3..ef447eb78 100644 --- a/deps.edn +++ b/deps.edn @@ -65,7 +65,7 @@ mvxcvi/puget {:mvn/version "1.3.2"} ;; Time - tick/tick {:mvn/version "0.5.0-RC5"} + tick/tick {:mvn/version "0.5.0-RC6"} ;; Removing AWS means we now need a direct dependency on this jar for an ;; internal Nippy function. This is provided by later versions of XT, so From e4baf7c765c1426bf5805c7ed395719dbfb8bb58 Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 15 Jun 2022 14:02:08 +0100 Subject: [PATCH 11/33] nothing --- src/juxt/site/alpha/xtdb.clj | 1 + 1 file changed, 1 insertion(+) diff --git a/src/juxt/site/alpha/xtdb.clj b/src/juxt/site/alpha/xtdb.clj index 56e67cec0..86a1508d1 100644 --- a/src/juxt/site/alpha/xtdb.clj +++ b/src/juxt/site/alpha/xtdb.clj @@ -1,5 +1,6 @@ ;; Copyright © 2021, JUXT LTD. +(+) (ns juxt.site.alpha.xtdb) (defn inline-clj-pred [f & args] From ae81dcbb238f35a863ffab58cf57fbe26e6516d0 Mon Sep 17 00:00:00 2001 From: modality Date: Fri, 17 Jun 2022 08:36:58 +0100 Subject: [PATCH 12/33] S3Configurator --- deps.edn | 1 + src/juxt/site/alpha/db.clj | 42 ++++++++++++++++++++++++++++++++++++-- 2 files changed, 41 insertions(+), 2 deletions(-) diff --git a/deps.edn b/deps.edn index ef447eb78..aab300991 100644 --- a/deps.edn +++ b/deps.edn @@ -16,6 +16,7 @@ com.xtdb/xtdb-jdbc {:mvn/version "1.21.0"} com.xtdb/xtdb-s3 {:mvn/version "1.21.0"} mysql/mysql-connector-java {:mvn/version "8.0.29"} + diehard/diehard {:mvn/version "0.11.3"} ;; Jetty ring/ring-jetty-adapter {:mvn/version "1.9.5"} diff --git a/src/juxt/site/alpha/db.clj b/src/juxt/site/alpha/db.clj index 4d516c84e..3e3958283 100644 --- a/src/juxt/site/alpha/db.clj +++ b/src/juxt/site/alpha/db.clj @@ -4,11 +4,49 @@ (:require [xtdb.api :as xt] [integrant.core :as ig] - [clojure.tools.logging :as log])) + [clojure.tools.logging :as log] + [diehard.core :as dh]) + (:import + java.time.Duration + software.amazon.awssdk.services.s3.S3AsyncClient + software.amazon.awssdk.http.nio.netty.NettyNioAsyncHttpClient)) + + + +(def s3-configurator + (reify xtdb.s3.S3Configurator + (makeClient [_this] + (.. (S3AsyncClient/builder) + (httpClientBuilder + (.. (NettyNioAsyncHttpClient/builder) + (connectionAcquisitionTimeout (Duration/ofSeconds 600)) + (maxConcurrency (Integer. 100)) + (maxPendingConnectionAcquires (Integer. 10000)))) + (build))))) + +(defn- start-node + [config] + (dh/with-retry + {:retry-if + (fn [_ ex] + (= "incomplete checkpoint restore" + (ex-message ex))) + :max-retries 3 + :on-failed-attempt + (fn [_ ex] + (log/warn ex "Couldn't complete checkpoint restore")) + :on-failure + (fn [_ ex] + (log/error ex "Checkpoint restore failed"))} + (xt/start-node config))) (defmethod ig/init-key ::xt-node [_ xtdb-opts] (log/info "Starting XT node ...") - (let [node (xt/start-node xtdb-opts)] + + (let [config (update-in xtdb-opts + [:xtdb/index-store :kv-store :checkpointer :store] + assoc :configurator (constantly s3-configurator)) + node (start-node config)] ;; we need to make sure the tx-ingester has caught up before ;; declaring the node up (->> From 302fca9023fc2048d574235fbdb0c28576840edb Mon Sep 17 00:00:00 2001 From: modality Date: Mon, 20 Jun 2022 15:01:48 +0100 Subject: [PATCH 13/33] fixed nil arg in --- src/juxt/site/alpha/graphql.clj | 61 +++++++++++++++++---------------- 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/src/juxt/site/alpha/graphql.clj b/src/juxt/site/alpha/graphql.clj index 3fc8e20c9..9b913241e 100644 --- a/src/juxt/site/alpha/graphql.clj +++ b/src/juxt/site/alpha/graphql.clj @@ -512,8 +512,7 @@ :as field-resolver-args}] #_(when (= "SiteError" (get-in object-type [::g/name])) - (def object-value object-value) - ) + (def object-value object-value)) (let [types-by-name (::schema/types-by-name schema) field (get-in object-type [::schema/fields-by-name field-name]) @@ -527,21 +526,21 @@ (::g/name object-type)) db (try (cond - (and (not mutation?) - (get argument-values "asOf")) - (xt/db xt-node (-> argument-values - (get "asOf") - t/instant - t/inst)) - (and - (get variable-values "historicalDb") - (:_siteValidTime object-value)) - (do - (xt/db xt-node (-> object-value - :_siteValidTime - t/inst))) - :else - db) + (and (not mutation?) + (get argument-values "asOf")) + (xt/db xt-node (-> argument-values + (get "asOf") + t/instant + t/inst)) + (and + (get variable-values "historicalDb") + (:_siteValidTime object-value)) + (do + (xt/db xt-node (-> object-value + :_siteValidTime + t/inst))) + :else + db) (catch Exception _ db)) object-id (:xt/id object-value) ;; TODO: Protected lookup please! @@ -610,7 +609,11 @@ args (if (second query-args) query-args (first query-args)) results (try - (xt/q db q args) + ;; XTDB >= 1.21.0 is asserting (= (count in-bindings) (count in-args)) + ;; args can be `nil` and `xt/q` is variadic + (if (nil? args) + (xt/q db q) ;; XTDB 1.21 has an + (xt/q db q args)) (catch Exception e (throw (ex-info "Failure when running XTDB query" {:message (ex-message e) @@ -619,12 +622,11 @@ e)))) limited-results (limit-results argument-values results) result-entities (cond->> - (pull-entities db xt-node subject limited-results q) - (get site-args "a") - (map (keyword (get site-args "a"))) + (pull-entities db xt-node subject limited-results q) + (get site-args "a") + (map (keyword (get site-args "a"))))] - )] - ;;(log/tracef "GraphQL results is %s" (seq result-entities)) +;;(log/tracef "GraphQL results is %s" (seq result-entities)) (process-xt-results field result-entities)) @@ -648,8 +650,7 @@ (traverse object-value att subject db xt-node) (get object-value (keyword att))) transform-sym (some-> site-args (get "transform") symbol) - transform (when transform-sym (requiring-resolve transform-sym)) - ] + transform (when transform-sym (requiring-resolve transform-sym))] (if (= field-kind 'OBJECT) (protected-lookup val subject db xt-node) ;; TODO: check for lists @@ -748,12 +749,12 @@ (get-in field [::schema/directives-by-name "onObject"]) (contains? object-value (keyword field-name)))) (let [result (get object-value (keyword field-name))] - (cond - (-> field ::g/type-ref list-type?) - (limit-results argument-values result) + (cond + (-> field ::g/type-ref list-type?) + (limit-results argument-values result) ;; TODO validate enum (enum? (field->type field) types-by-name) - :else - result)) + :else + result)) (and (field->type field) (not (scalar? (field->type field) types-by-name)) From 32644492fcbdf26a2084a6435bab3413b201f7b2 Mon Sep 17 00:00:00 2001 From: modality Date: Tue, 21 Jun 2022 08:06:13 +0100 Subject: [PATCH 14/33] xt/q variadics --- src/juxt/site/alpha/graphql.clj | 20 +++++++++++--------- src/juxt/site/alpha/handler.clj | 9 ++++++++- src/juxt/site/alpha/repl.clj | 4 +++- src/juxt/site/alpha/util.clj | 3 ++- 4 files changed, 24 insertions(+), 12 deletions(-) diff --git a/src/juxt/site/alpha/graphql.clj b/src/juxt/site/alpha/graphql.clj index 9b913241e..1dbcaac3e 100644 --- a/src/juxt/site/alpha/graphql.clj +++ b/src/juxt/site/alpha/graphql.clj @@ -16,14 +16,13 @@ [clojure.tools.logging :as log] [clojure.walk :refer [postwalk keywordize-keys]] [clojure.edn :as edn] - [tick.core :as t])) - -(alias 'apex (create-ns 'juxt.apex.alpha)) -(alias 'site (create-ns 'juxt.site.alpha)) -(alias 'http (create-ns 'juxt.http.alpha)) -(alias 'grab (create-ns 'juxt.grab.alpha)) -(alias 'pass (create-ns 'juxt.pass.alpha)) -(alias 'g (create-ns 'juxt.grab.alpha.graphql)) + [tick.core :as t] + [juxt.apex.alpha :as-alias apex] + [juxt.site.alpha :as-alias site] + [juxt.http.alpha :as-alias http] + [juxt.grab.alpha :as-alias grab] + [juxt.pass.alpha :as-alias pass] + [juxt.grab.alpha.graphql :as-alias g])) (defn field->type [field] @@ -408,7 +407,10 @@ (defn infer-query [db xt-node subject field query args] (let [type (field->type field) - results (pull-entities db xt-node subject (xt/q db query type) query)] + results (pull-entities db xt-node subject + (if (nil? type) + (xt/q db query) + (xt/q db query type)) query)] (or (process-xt-results field results) (throw (ex-info "No resolver found for " type))))) diff --git a/src/juxt/site/alpha/handler.clj b/src/juxt/site/alpha/handler.clj index 0498387f2..37a56d7c8 100644 --- a/src/juxt/site/alpha/handler.clj +++ b/src/juxt/site/alpha/handler.clj @@ -808,6 +808,13 @@ ;; itself should be ignorant of such policies. Additionally, this is more ;; aligned to OpenAPI's declaration of per-resource errors. +(defn- q + "xt/q is variadic; XTDB 1.21 assert (= (count args-in-query) (count args))" + [db query args] + (if (nil? args) + (xt/q db query) + (xt/q db query args))) + (defn error-resource "Locate an error resource. Currently only uses a simple database lookup of an 'ErrorResource' entity matching the status. In future this could use rules to @@ -815,7 +822,7 @@ variables to determine the resource to use." [{::site/keys [db]} status] (when-let [res (ffirst - (xt/q db '{:find [(pull er [*])] + (q db '{:find [(pull er [*])] :where [[er ::site/type "ErrorResource"] [er :ring.response/status status]] :in [status]} status))] diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 11bb1833a..8a3c222e1 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -107,7 +107,9 @@ (xt/await-tx (xt-node)))) (defn q [query & args] - (apply xt/q (db) query args)) + (if (nil? args) + (apply xt/q (db) query) + (apply xt/q (db) query args))) (defn t [t] (map diff --git a/src/juxt/site/alpha/util.clj b/src/juxt/site/alpha/util.clj index 03845a55c..0abf91033 100644 --- a/src/juxt/site/alpha/util.clj +++ b/src/juxt/site/alpha/util.clj @@ -2,7 +2,8 @@ (ns juxt.site.alpha.util (:require - [juxt.clojars-mirrors.nippy.v3v1v1.taoensso.nippy.utils :refer [freezable?]])) + [juxt.clojars-mirrors.nippy.v3v1v1.taoensso.nippy.utils :refer [freezable?]] + [xtdb.api :as xt])) (alias 'site (create-ns 'juxt.site.alpha)) (alias 'http (create-ns 'juxt.http.alpha)) From c46f29cb438e0b2f64e2e68190f5838af7459b4a Mon Sep 17 00:00:00 2001 From: modality Date: Tue, 21 Jun 2022 11:24:40 +0100 Subject: [PATCH 15/33] nil argument --- src/juxt/site/alpha/graphql.clj | 4 ++-- src/juxt/site/alpha/handler.clj | 2 +- src/juxt/site/alpha/repl.clj | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/juxt/site/alpha/graphql.clj b/src/juxt/site/alpha/graphql.clj index 1dbcaac3e..b710a5040 100644 --- a/src/juxt/site/alpha/graphql.clj +++ b/src/juxt/site/alpha/graphql.clj @@ -612,8 +612,8 @@ results (try ;; XTDB >= 1.21.0 is asserting (= (count in-bindings) (count in-args)) - ;; args can be `nil` and `xt/q` is variadic - (if (nil? args) + ;; args can be `(nil)` and `xt/q` is variadic + (if (= '(nil) args) (xt/q db q) ;; XTDB 1.21 has an (xt/q db q args)) (catch Exception e diff --git a/src/juxt/site/alpha/handler.clj b/src/juxt/site/alpha/handler.clj index 37a56d7c8..e52a8852e 100644 --- a/src/juxt/site/alpha/handler.clj +++ b/src/juxt/site/alpha/handler.clj @@ -811,7 +811,7 @@ (defn- q "xt/q is variadic; XTDB 1.21 assert (= (count args-in-query) (count args))" [db query args] - (if (nil? args) + (if (= '(nil) args) (xt/q db query) (xt/q db query args))) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 8a3c222e1..b172f964b 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -107,7 +107,7 @@ (xt/await-tx (xt-node)))) (defn q [query & args] - (if (nil? args) + (if (= '(nil) args) (apply xt/q (db) query) (apply xt/q (db) query args))) From 718fbd9813a8a59f95c7a9b0737a649a93d2e45f Mon Sep 17 00:00:00 2001 From: modality Date: Tue, 21 Jun 2022 11:58:32 +0100 Subject: [PATCH 16/33] args --- src/juxt/site/alpha/graphql.clj | 17 ++++++----------- src/juxt/site/alpha/handler.clj | 5 +---- src/juxt/site/alpha/repl.clj | 4 +--- 3 files changed, 8 insertions(+), 18 deletions(-) diff --git a/src/juxt/site/alpha/graphql.clj b/src/juxt/site/alpha/graphql.clj index b710a5040..81ea073eb 100644 --- a/src/juxt/site/alpha/graphql.clj +++ b/src/juxt/site/alpha/graphql.clj @@ -405,12 +405,9 @@ :_siteQuery (and query (pr-str query))))) (defn infer-query - [db xt-node subject field query args] + [db xt-node subject field query] (let [type (field->type field) - results (pull-entities db xt-node subject - (if (nil? type) - (xt/q db query) - (xt/q db query type)) query)] + results (pull-entities db xt-node subject (xt/q db query) query)] (or (process-xt-results field results) (throw (ex-info "No resolver found for " type))))) @@ -611,11 +608,10 @@ args (if (second query-args) query-args (first query-args)) results (try - ;; XTDB >= 1.21.0 is asserting (= (count in-bindings) (count in-args)) - ;; args can be `(nil)` and `xt/q` is variadic - (if (= '(nil) args) - (xt/q db q) ;; XTDB 1.21 has an + (if (nil? args) + (xt/q db q) (xt/q db q args)) + (catch Exception e (throw (ex-info "Failure when running XTDB query" {:message (ex-message e) @@ -765,8 +761,7 @@ xt-node subject field - (to-xt-query opts) - argument-values) + (to-xt-query opts)) (get argument-values "id") (xt/entity db (get argument-values "id")) diff --git a/src/juxt/site/alpha/handler.clj b/src/juxt/site/alpha/handler.clj index e52a8852e..bd4930c29 100644 --- a/src/juxt/site/alpha/handler.clj +++ b/src/juxt/site/alpha/handler.clj @@ -809,11 +809,8 @@ ;; aligned to OpenAPI's declaration of per-resource errors. (defn- q - "xt/q is variadic; XTDB 1.21 assert (= (count args-in-query) (count args))" [db query args] - (if (= '(nil) args) - (xt/q db query) - (xt/q db query args))) + (xt/q db query args)) (defn error-resource "Locate an error resource. Currently only uses a simple database lookup of an diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index b172f964b..11bb1833a 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -107,9 +107,7 @@ (xt/await-tx (xt-node)))) (defn q [query & args] - (if (= '(nil) args) - (apply xt/q (db) query) - (apply xt/q (db) query args))) + (apply xt/q (db) query args)) (defn t [t] (map From cbb7c5136d78546e128fe9802becd13eb3e6c08e Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 22 Jun 2022 08:46:36 +0100 Subject: [PATCH 17/33] deactivate skipping import --- src/juxt/site/alpha/repl.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 11bb1833a..8b1025fc5 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -184,7 +184,7 @@ ([] (import-resources "import/resources.edn")) ([filename] (let [node (xt-node)] - (if (xt/entity (xt/db (xt-node)) filename) + (if 0 #_(xt/entity (xt/db (xt-node)) filename) (println "Skipping already imported: " filename) (let [in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] (doseq [rec (resources-from-stream in)] From 0337ea3098e0f827bcd4ff94e384dee5af011241 Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 22 Jun 2022 11:47:54 +0100 Subject: [PATCH 18/33] submit-and-wait --- src/juxt/site/alpha/repl.clj | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 8b1025fc5..5fc6c6189 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -179,12 +179,16 @@ :else nil))) +(defn- submit-and-wait-tx + [node tx] + (let [tx-id (xt/submit-tx node tx)] + (xt/await-tx node tx-id))) -(defn import-resources - ([] (import-resources "import/resources.edn")) +(defn import-resources-skip + ([] (import-resources-skip "import/resources.edn")) ([filename] (let [node (xt-node)] - (if 0 #_(xt/entity (xt/db (xt-node)) filename) + (if (xt/entity (xt/db (xt-node)) filename) (println "Skipping already imported: " filename) (let [in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] (doseq [rec (resources-from-stream in)] @@ -195,6 +199,18 @@ (xt/sync node) (println "Import finished.")))))) + + +(defn import-resources + ([] (import-resources "import/resources.edn")) + ([filename] + (let [node (xt-node) + in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] + (doseq [rec (resources-from-stream in)] + (println "Importing record" (:xt/id rec)) + (when (:xt/id rec) + (submit-and-wait-tx node [[:xtdb.api/put rec]])))))) + (defn validate-resource-line [s] (edn/read-string {:eof :eof :readers edn-readers} From bf607214bd9abe93774428052158b1e5d8f3f26b Mon Sep 17 00:00:00 2001 From: Alex Davis Date: Wed, 22 Jun 2022 16:09:16 +0100 Subject: [PATCH 19/33] Add some debugging utils --- src/juxt/site/alpha/handler.clj | 25 ++++++++++++++++++++++++- src/juxt/site/alpha/repl.clj | 24 ++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 1 deletion(-) diff --git a/src/juxt/site/alpha/handler.clj b/src/juxt/site/alpha/handler.clj index bd4930c29..9307189a5 100644 --- a/src/juxt/site/alpha/handler.clj +++ b/src/juxt/site/alpha/handler.clj @@ -1175,13 +1175,36 @@ (assoc-in [:ring.response/headers "retry-after"] "120"))}))) (h req))) +(def cors-headers + "Generic CORS headers" + {"Access-Control-Allow-Origin" "*" + "Access-Control-Allow-Headers" "*" + "Access-Control-Allow-Methods" "GET"}) + +(defn preflight? + "Returns true if the request is a preflight request" + [request] + (= (request :request-method) :options)) + +(defn all-cors + "Allow requests from all origins - also check preflight" + [handler] + (fn [request] + (if (preflight? request) + {:status 200 + :headers cors-headers + :body "preflight complete"} + (let [response (handler request)] + (update-in response [:headers] + merge cors-headers ))))) + (defn make-pipeline "Make a pipeline of Ring middleware. Note, that each Ring middleware designates a processing stage. An interceptor chain (perhaps using Pedestal (pedestal.io) or Sieppari (https://github.com/metosin/sieppari) could be used. This is currently a synchronous chain but async could be supported in the future." [opts] - [ + [all-cors ;; Switch Ring requests/responses to Ring 2 namespaced keywords wrap-ring-1-adapter diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 5fc6c6189..5d7fcde98 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -510,3 +510,27 @@ schema (:juxt.grab.alpha/schema (e (format "%s/_site/graphql" (::site/base-uri config)))) document (graphql.document/compile-document (graphql.parser/parse (slurp (io/file "opt/graphql/graphiql-introspection-query.graphql"))) schema)] (graphql/query schema document "IntrospectionQuery" {} {::site/db (db)}))) + +(defn repl-post-handler [{::site/keys [uri db] + ::pass/keys [subject] + :as req}] + (let [ + body (some-> req ::site/received-representation ::http/body (String.) read-string) + _ (when (nil? body) + (throw + (ex-info + "Invalid body" + {::site/request-context req}))) + + results (try + (binding [*ns* (find-ns 'juxt.site.alpha.repl)] + (eval body)) + (catch Exception e + (throw (ex-info "Syntax error" e))))] + + (-> req + (assoc + :ring.response/status 200 + :ring.response/body + (json/write-value-as-string results)) + (update :ring.response/headers assoc "content-type" "application/json")))) From 6f64eb2b630a44947ca2273a413945903ef85898 Mon Sep 17 00:00:00 2001 From: modality Date: Fri, 24 Jun 2022 10:53:03 +0100 Subject: [PATCH 20/33] import resources skip of already loaded --- src/juxt/site/alpha/repl.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 5d7fcde98..5e977adb6 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -184,7 +184,7 @@ (let [tx-id (xt/submit-tx node tx)] (xt/await-tx node tx-id))) -(defn import-resources-skip +(defn import-resources ([] (import-resources-skip "import/resources.edn")) ([filename] (let [node (xt-node)] @@ -201,7 +201,7 @@ -(defn import-resources +(defn import-resources-non-skip ([] (import-resources "import/resources.edn")) ([filename] (let [node (xt-node) From 1eefeaf6ac460ec74456dbf3bf2377f4671c2a77 Mon Sep 17 00:00:00 2001 From: modality Date: Fri, 24 Jun 2022 11:09:07 +0100 Subject: [PATCH 21/33] typp --- src/juxt/site/alpha/repl.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 5e977adb6..3c47e6860 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -185,7 +185,7 @@ (xt/await-tx node tx-id))) (defn import-resources - ([] (import-resources-skip "import/resources.edn")) + ([] (import-resources "import/resources.edn")) ([filename] (let [node (xt-node)] (if (xt/entity (xt/db (xt-node)) filename) @@ -202,7 +202,7 @@ (defn import-resources-non-skip - ([] (import-resources "import/resources.edn")) + ([] (import-resources-non-skip "import/resources.edn")) ([filename] (let [node (xt-node) in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] From c143b79e43fd5290c412b3eecce719adcbcb9bb4 Mon Sep 17 00:00:00 2001 From: modality Date: Fri, 24 Jun 2022 11:48:22 +0100 Subject: [PATCH 22/33] no skipping --- src/juxt/site/alpha/repl.clj | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 3c47e6860..5d7fcde98 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -184,8 +184,8 @@ (let [tx-id (xt/submit-tx node tx)] (xt/await-tx node tx-id))) -(defn import-resources - ([] (import-resources "import/resources.edn")) +(defn import-resources-skip + ([] (import-resources-skip "import/resources.edn")) ([filename] (let [node (xt-node)] (if (xt/entity (xt/db (xt-node)) filename) @@ -201,8 +201,8 @@ -(defn import-resources-non-skip - ([] (import-resources-non-skip "import/resources.edn")) +(defn import-resources + ([] (import-resources "import/resources.edn")) ([filename] (let [node (xt-node) in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] From f3dcfcc86cf4010e80588d4bc1eb69d9261ecc1d Mon Sep 17 00:00:00 2001 From: modality Date: Mon, 27 Jun 2022 12:12:29 +0100 Subject: [PATCH 23/33] no skip --- src/juxt/site/alpha/repl.clj | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 5d7fcde98..f85b857e6 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -184,8 +184,8 @@ (let [tx-id (xt/submit-tx node tx)] (xt/await-tx node tx-id))) -(defn import-resources-skip - ([] (import-resources-skip "import/resources.edn")) +(defn import-resources + ([] (import-resources "import/resources.edn")) ([filename] (let [node (xt-node)] (if (xt/entity (xt/db (xt-node)) filename) @@ -201,8 +201,8 @@ -(defn import-resources - ([] (import-resources "import/resources.edn")) +(defn import-resources-no-skip + ([] (import-resources-no-skip"import/resources.edn")) ([filename] (let [node (xt-node) in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] From 0ca31de0430888da463d9537e714e81bd4f7124c Mon Sep 17 00:00:00 2001 From: modality Date: Mon, 27 Jun 2022 12:54:34 +0100 Subject: [PATCH 24/33] skip existing resources --- src/juxt/site/alpha/repl.clj | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index f85b857e6..6bc22f4fc 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -184,8 +184,8 @@ (let [tx-id (xt/submit-tx node tx)] (xt/await-tx node tx-id))) -(defn import-resources - ([] (import-resources "import/resources.edn")) +(defn import-resources-skip + ([] (import-resources-skip "import/resources.edn")) ([filename] (let [node (xt-node)] (if (xt/entity (xt/db (xt-node)) filename) @@ -199,17 +199,18 @@ (xt/sync node) (println "Import finished.")))))) - - -(defn import-resources-no-skip - ([] (import-resources-no-skip"import/resources.edn")) +(defn import-resources + ([] (import-resources "import/resources.edn")) ([filename] (let [node (xt-node) in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] (doseq [rec (resources-from-stream in)] - (println "Importing record" (:xt/id rec)) (when (:xt/id rec) - (submit-and-wait-tx node [[:xtdb.api/put rec]])))))) + (if (xt/entity node (:xt/id rec)) + (println "Skipping existing resource: " (:xt/id rec)) + (do + (submit-and-wait-tx node [[:xtdb.api/put rec]]) + (println "Imported resource: " (:xt/id rec))))))))) (defn validate-resource-line [s] (edn/read-string From 30ef0c1ad2f990ed2eaf9da44d94636f15691f55 Mon Sep 17 00:00:00 2001 From: modality Date: Mon, 27 Jun 2022 13:04:28 +0100 Subject: [PATCH 25/33] xt/entity db --- src/juxt/site/alpha/repl.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 6bc22f4fc..0dca3f310 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -206,7 +206,7 @@ in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] (doseq [rec (resources-from-stream in)] (when (:xt/id rec) - (if (xt/entity node (:xt/id rec)) + (if (xt/entity (xt/db node) (:xt/id rec)) (println "Skipping existing resource: " (:xt/id rec)) (do (submit-and-wait-tx node [[:xtdb.api/put rec]]) From 01016136ed09c38c17f652d636b319aee7af6e26 Mon Sep 17 00:00:00 2001 From: Alex Davis Date: Tue, 5 Jul 2022 10:38:05 +0100 Subject: [PATCH 26/33] Update site (#2) * Ignore :_siteCreateAt when verifying mutation Fixes a broken test that is currently causing the CI build to fail. FAIL in juxt.site.graphql-test/mutation-test (graphql_test.clj:280) Expected: {:name "Malcolm Sparks", :juxt.site/type "Person", :xt/id "https://example.org/persons/mal"} Actual: {:name "Malcolm Sparks", :juxt.site/type "Person", :xt/id "https://example.org/persons/mal", +:_siteCreatedAt "2022-05-26T13:28:50.568652Z"} * upgrading Grab to latest (#76) * Upgrade grab (#77) * upgrading Grab to latest * actually change the SHA Co-authored-by: Malcolm Sparks * added enum case (#79) * Update xtdb to 1.21 * Fix Indentation Does clojure have a way to indent properly automatically.... * allow templating of subject username in q directive * Improve resource importing/seeding * Add cache control headers * Use protected lookup * Possibility to insert schema to validate data against as a site directive * allow to mutate when there is no schema directive * fix wrong validation schema * negation logic in validation check, append test for mutation with schema * append test with validation error * Clean up unwanted changes from other branch * make validation pass when no directive, align tests * define `mutation-base` for more concise tests * Extract selmer args to common function * Fix indentation Co-authored-by: Joe Littlejohn Co-authored-by: reborg Co-authored-by: Malcolm Sparks Co-authored-by: Jamie <36566373+CirrusClouds@users.noreply.github.com> Co-authored-by: vollcheck --- deps.edn | 7 +- src/juxt/site/alpha/debug.clj | 7 +- src/juxt/site/alpha/graphql.clj | 1182 +++++++++++----------- src/juxt/site/alpha/graphql_resolver.clj | 72 +- src/juxt/site/alpha/handler.clj | 555 +++++----- src/juxt/site/alpha/repl.clj | 168 +-- src/juxt/site/alpha/rules.clj | 34 +- test/juxt/site/graphql_test.clj | 418 +++++--- 8 files changed, 1307 insertions(+), 1136 deletions(-) diff --git a/deps.edn b/deps.edn index aab300991..b8423531b 100644 --- a/deps.edn +++ b/deps.edn @@ -15,12 +15,16 @@ com.xtdb/xtdb-http-server {:mvn/version "1.21.0"} com.xtdb/xtdb-jdbc {:mvn/version "1.21.0"} com.xtdb/xtdb-s3 {:mvn/version "1.21.0"} + mysql/mysql-connector-java {:mvn/version "8.0.29"} diehard/diehard {:mvn/version "0.11.3"} ;; Jetty ring/ring-jetty-adapter {:mvn/version "1.9.5"} + ;; GraphQL schema validation + metosin/malli {:mvn/version "0.8.4"} + ;; Logging org.clojure/tools.logging {:mvn/version "1.2.4"} org.slf4j/jcl-over-slf4j {:mvn/version "1.7.36"} @@ -37,7 +41,7 @@ juxt/grab {:git/url "https://github.com/juxt/grab.git" - :sha "50953efcb1cc1d104fa8f779795ae6e4944852c9" + :sha "62fc7f2869360d21a418eac9a01d999651a39c60" ;;:local/root "../grab" } @@ -89,6 +93,7 @@ {:extra-paths ["dev" "test"] :extra-deps {;; Convenience libraries made available during development org.clojure/test.check {:mvn/version "1.1.1"} + nrepl/nrepl {:mvn/version "0.9.0"} org.clojure/alpha.spec {:git/url "https://github.com/clojure/spec-alpha2.git" :sha "99456b1856a6fd934e2c30b17920bd790dd81775"} org.eclipse.jetty/jetty-jmx {:mvn/version "9.4.44.v20210927"}} diff --git a/src/juxt/site/alpha/debug.clj b/src/juxt/site/alpha/debug.clj index 704ca19e0..88d082a7f 100644 --- a/src/juxt/site/alpha/debug.clj +++ b/src/juxt/site/alpha/debug.clj @@ -20,16 +20,14 @@ {::http/content-type "application/json" ::http/etag "\"v1\"" ::http/last-modified (:juxt.site.alpha/start-date request-to-show) + :ring.response/headers {"Cache-Control" "public, max-age=604800, immutable"} ::site/body-fn (fn [req] (-> (sorted-map) (into request-to-show) (json/write-value-as-string default-object-mapper) (str "\r\n") - (.getBytes))) - ;; TODO: use Cache-Control: immutable - see - ;; https://www.keycdn.com/blog/cache-control-immutable and others - }) + (.getBytes)))}) (defn html-representation-of-request [{::site/keys [db base-uri]} request-to-show] (let [template (str base-uri "/_site/templates/debug-request.html")] @@ -41,7 +39,6 @@ ::site/type "TemplatedRepresentation" ::site/template template ::site/template-model request-to-show - #_#_::site/body-fn (fn [req] "

Coming Soon...

") diff --git a/src/juxt/site/alpha/graphql.clj b/src/juxt/site/alpha/graphql.clj index 81ea073eb..994975df1 100644 --- a/src/juxt/site/alpha/graphql.clj +++ b/src/juxt/site/alpha/graphql.clj @@ -4,6 +4,8 @@ (:require [ring.util.codec :refer [form-decode]] [selmer.parser :as selmer] + [malli.core :as m] + [malli.error :as me] [juxt.grab.alpha.schema :as schema] [juxt.grab.alpha.document :as document] [jsonista.core :as json] @@ -24,37 +26,44 @@ [juxt.pass.alpha :as-alias pass] [juxt.grab.alpha.graphql :as-alias g])) +(defn selmer-args + [{:keys [argument-values pass/subject object-value type-k]}] + {"object-id" (:xt/id object-value) + "args" argument-values + "type-k" type-k + "username" (::pass/username subject)}) + (defn field->type [field] (or - (-> field - ::g/type-ref - ::g/non-null-type - ::g/list-type - ::g/name) - (-> field - ::g/type-ref - ::g/non-null-type - ::g/list-type - ::g/non-null-type - ::g/name) - (-> field - ::g/type-ref - ::g/list-type - ::g/name) - (-> field - ::g/type-ref - ::g/name) - (-> field - ::g/type-ref - ::g/non-null-type - ::g/name))) + (-> field + ::g/type-ref + ::g/non-null-type + ::g/list-type + ::g/name) + (-> field + ::g/type-ref + ::g/non-null-type + ::g/list-type + ::g/non-null-type + ::g/name) + (-> field + ::g/type-ref + ::g/list-type + ::g/name) + (-> field + ::g/type-ref + ::g/name) + (-> field + ::g/type-ref + ::g/non-null-type + ::g/name))) (defn list-type? [type-ref] (or - (-> type-ref ::g/non-null-type ::g/list-type) - (::g/list-type type-ref))) + (-> type-ref ::g/non-null-type ::g/list-type) + (::g/list-type type-ref))) (defn default-query [field-or-type type-k] @@ -65,35 +74,34 @@ ['e :_siteCreatedAt '_siteCreatedAt]]})) (defn to-xt-query - [{:keys [custom-xt-query field argument-values type-k site-args object-value]}] + [{:keys [custom-xt-query field argument-values type-k + site-args] :as opts}] (let [values argument-values field-or-type (or - (get site-args "type") - field) + (get site-args "type") + field) query (or - custom-xt-query - (get site-args "q") - (default-query field-or-type type-k)) + custom-xt-query + (get site-args "q") + (default-query field-or-type type-k)) result (postwalk - (fn [x] - (try - (cond-> x - (and (map? x) (:keyword x)) - (-> (get :keyword) keyword) - (and (map? x) (:set x)) - (-> (get :set) set) - (and (map? x) (:edn x)) - (-> (get :edn) - (selmer/render {"type" type-k - "object-id" (:xt/id object-value) - "args" values}) - edn/read-string) - (= 'type x) - ((constantly type-k))) - (catch Exception e - (throw (ex-info "Error in q site arg" {:x x} e))))) - query) + (fn [x] + (try + (cond-> x + (and (map? x) (:keyword x)) + (-> (get :keyword) keyword) + (and (map? x) (:set x)) + (-> (get :set) set) + (and (map? x) (:edn x)) + (-> (get :edn) + (selmer/render (selmer-args opts)) + edn/read-string) + (= 'type x) + ((constantly type-k))) + (catch Exception e + (throw (ex-info "Error in q site arg" {:x x} e))))) + query) limit (get values "limit") offset (get values "offset") order (keyword (get values "order")) @@ -116,20 +124,20 @@ limit :desc :else nil) result (assoc-some - result - :find (and search? '[e v s]) - :order-by (cond - search? - '[[s :desc]] - order-by-dir - [['_siteCreatedAt order-by-dir]] - :else - nil) - :where (and search-where-clauses - (vec (concat (:where result) search-where-clauses))) - :limit limit - :offset (when (pos-int? offset) - offset))] + result + :find (and search? '[e v s]) + :order-by (cond + search? + '[[s :desc]] + order-by-dir + [['_siteCreatedAt order-by-dir]] + :else + nil) + :where (and search-where-clauses + (vec (concat (:where result) search-where-clauses))) + :limit limit + :offset (when (pos-int? offset) + offset))] result)) (defn generate-value [{:keys [type pathPrefix template] :as gen-args} args] @@ -157,13 +165,13 @@ (throw (ex-info "Couldn't infer type" {:field field})))] (cond-> entity true (assoc - :xt/id (or - (:xt/id entity) - (:id entity) - (generate-value - {:type "UUID" - :pathPrefix type} - {}))) + :xt/id (or + (:xt/id entity) + (:id entity) + (generate-value + {:type "UUID" + :pathPrefix type} + {}))) ;; this should use a clock component that keeps the same time for ;; everything in a single graphql transcation (nil? (:_siteCreatedAt entity)) (assoc :_siteCreatedAt (str (t/now))) @@ -187,98 +195,98 @@ (throw (ex-info "Failed to resolve transform fn" {:transform transform-sym}))) entity (reduce - (fn [acc arg-def] - (let [site-args (get-in arg-def [::schema/directives-by-name "site" ::g/arguments]) - generator-args (get site-args "gen") - transform-sym (some-> site-args (get "transform") symbol) - transform (when transform-sym (requiring-resolve transform-sym)) - kw (get-in arg-def [::schema/directives-by-name "site" ::g/arguments "a"]) - arg-name (::g/name arg-def) - key (keyword (or kw arg-name)) - type-ref (::g/type-ref arg-def) - arg-type (or - (get-in site-args "objectType") - (::g/name type-ref) - (-> type-ref ::g/non-null-type ::g/name))] - - (when (and transform-sym (not transform)) - (throw (ex-info "Failed to resolve transform fn" {:transform transform-sym}))) - - (when transform - (log/tracef "transform is %s" transform)) - - (cond - arg-type ; not a LIST - (let [value (or - ;; If provided we use it - (get args arg-name) - ;; Else we try to generate it - (generate-value generator-args args) - ) - value - (cond-> value - ;; We don't want symbols in XT entities, because this leaks the - ;; form-plane into the data-plane! - (symbol? value) str - - ;; Replace base-uri in string-template, only for an ID - ;; since we should be careful not to tamper with other - ;; values. - (and (string? value) (= arg-type "ID")) - (selmer/render {"base-uri" base-uri}) - - ;; Transform value - transform transform)] - - (cond - (or kw (scalar? arg-type types-by-name)) - (assoc-some acc key value) - - :else - (try - (merge acc (keywordize-keys value)) - ;; TODO if we need to assoc, like if someone wants to nest - ;; a map inside an entity to prevent it being indexed, then - ;; that needs to happen here. probably with a directive to - ;; differentiate from the default which is to merge (which - ;; is needed to support input types) - (catch Exception e - (throw - (ex-info - "Cannot merge value into acc" - {:acc acc - :arg-type arg-type - :value value} - e)))))) - - ;; Is it a list? Then put in as a vector - (list-type? type-ref) - (let [val (or (get args (name key)) - ;; TODO: default value? - (generate-value generator-args args)) - ;; Change a symbol value into a string - - ;; We don't want symbols in XT entities, because this leaks the - ;; form-plane into the data-plane! - val (cond-> val (symbol? val) str) - - list-type (field->type arg-def)] - (cond - (scalar? list-type types-by-name) (assoc-some acc key val) - :else - (throw (ex-info "Unsupported list-type" {:arg-def arg-def - :list-type list-type})))) - - :else (throw (ex-info "Unsupported arg-def" {:arg-def arg-def}))))) - {} - (::g/arguments-definition field))] + (fn [acc arg-def] + (let [site-args (get-in arg-def [::schema/directives-by-name "site" ::g/arguments]) + generator-args (get site-args "gen") + transform-sym (some-> site-args (get "transform") symbol) + transform (when transform-sym (requiring-resolve transform-sym)) + kw (get-in arg-def [::schema/directives-by-name "site" ::g/arguments "a"]) + arg-name (::g/name arg-def) + key (keyword (or kw arg-name)) + type-ref (::g/type-ref arg-def) + arg-type (or + (get-in site-args "objectType") + (::g/name type-ref) + (-> type-ref ::g/non-null-type ::g/name))] + + (when (and transform-sym (not transform)) + (throw (ex-info "Failed to resolve transform fn" {:transform transform-sym}))) + + (when transform + (log/tracef "transform is %s" transform)) + + (cond + arg-type ; not a LIST + (let [value (or + ;; If provided we use it + (get args arg-name) + ;; Else we try to generate it + (generate-value generator-args args) + ) + value + (cond-> value + ;; We don't want symbols in XT entities, because this leaks the + ;; form-plane into the data-plane! + (symbol? value) str + + ;; Replace base-uri in string-template, only for an ID + ;; since we should be careful not to tamper with other + ;; values. + (and (string? value) (= arg-type "ID")) + (selmer/render {"base-uri" base-uri}) + + ;; Transform value + transform transform)] + + (cond + (or kw (scalar? arg-type types-by-name) (enum? arg-type types-by-name)) + (assoc-some acc key value) + + :else + (try + (merge acc (keywordize-keys value)) + ;; TODO if we need to assoc, like if someone wants to nest + ;; a map inside an entity to prevent it being indexed, then + ;; that needs to happen here. probably with a directive to + ;; differentiate from the default which is to merge (which + ;; is needed to support input types) + (catch Exception e + (throw + (ex-info + "Cannot merge value into acc" + {:acc acc + :arg-type arg-type + :value value} + e)))))) + + ;; Is it a list? Then put in as a vector + (list-type? type-ref) + (let [val (or (get args (name key)) + ;; TODO: default value? + (generate-value generator-args args)) + ;; Change a symbol value into a string + + ;; We don't want symbols in XT entities, because this leaks the + ;; form-plane into the data-plane! + val (cond-> val (symbol? val) str) + + list-type (field->type arg-def)] + (cond + (scalar? list-type types-by-name) (assoc-some acc key val) + :else + (throw (ex-info "Unsupported list-type" {:arg-def arg-def + :list-type list-type})))) + + :else (throw (ex-info "Unsupported arg-def" {:arg-def arg-def}))))) + {} + (::g/arguments-definition field))] (prepare-mutation-entity opts entity transform))) (defn args-to-entities [{:keys [argument-values field types-by-name] :as opts}] (let [args (and - (= 1 (count argument-values)) - (first (vals argument-values)))] + (= 1 (count argument-values)) + (first (vals argument-values)))] (when-not args (throw (ex-info "Mutations that insert multiple entities must take a single InputType as their only argument" argument-values))) @@ -308,10 +316,10 @@ (defn await-tx [xt-node txes] (xt/await-tx - xt-node - (xt/submit-tx xt-node - txes))) + (xt/submit-tx + xt-node + txes))) (defn xt-delete [id] @@ -371,15 +379,15 @@ (if-let [ent-ns (::pass/namespace ent)] (let [rules (some-> ent-ns lookup ::pass/rules) acls (->> - (xt/q - db - {:find ['(pull ?acl [*])] - :where '[[?acl ::pass/type "ACL"] - (check ?acl ?subject ?e)] - :rules rules - :in '[?subject ?e]} - subject e) - (map first))] + (xt/q + db + {:find ['(pull ?acl [*])] + :where '[[?acl ::pass/type "ACL"] + (check ?acl ?subject ?e)] + :rules rules + :in '[?subject ?e]} + subject e) + (map first))] (when (seq acls) ;; TODO: Also use the ACL to infer when/whether to select-keys ;;(select-keys ent (apply concat (map :keys acls))) @@ -415,10 +423,10 @@ (if (seq atts) (let [next-object-value (get - (cond-> object-value - (string? object-value) - (protected-lookup subject db xt-node)) - (keyword (first atts)))] + (cond-> object-value + (string? object-value) + (protected-lookup subject db xt-node)) + (keyword (first atts)))] (traverse next-object-value (rest atts) subject db xt-node)) @@ -437,6 +445,27 @@ (log/debugf "defaulting to nil, type-ref is %s" type-ref) nil)))) +(defn invalid-arguments? + [{:keys [argument-values field] :as opts}] + (when-let [directive (get-in field [::schema/directives-by-name + "site" + ::g/arguments + "validation"])] + (->> (keywordize-keys argument-values) + (map + (fn [[k v]] + (let [validation-schema (some-> directive + (get k) + (selmer/render (selmer-args opts)) + edn/read-string) + invalid? (when (seq validation-schema) + (not (m/validate validation-schema v)))] + (when invalid? + (me/humanize (m/explain validation-schema v)))))) + (remove nil?)))) + + + (defn perform-mutation! [{:keys [argument-values site-args xt-node lookup-entity field-kind pass/subject] :as opts}] (let [action (or (get site-args "mutation") "put") @@ -453,13 +482,15 @@ ;; @site(a: "xtdb.api/valid-time"). (lookup-entity id)) "put" - (if bulk-mutation - (let [txes (args-to-entities opts)] - (put-objects! xt-node txes) - txes) - (let [tx (args-to-entity opts)] - (put-objects! xt-node [tx]) - tx)) + (if-let [validation-report (seq (invalid-arguments? opts))] + (throw (Exception. (pr-str validation-report))) + (if bulk-mutation + (let [txes (args-to-entities opts)] + (put-objects! xt-node txes) + txes) + (let [tx (args-to-entity opts)] + (put-objects! xt-node [tx]) + tx))) "update" (let [new-entity (args-to-entity opts) old-entity (some-> new-entity :xt/id lookup-entity) @@ -473,7 +504,7 @@ (-> as-of t/inst) (-> as-of (t/parse-date-time - (t/formatter :iso-local-date-time)) + (t/formatter :iso-local-date-time)) t/inst))) (catch Exception e (throw (ex-info "rollback mutations need a valid asOf argument" @@ -494,293 +525,292 @@ :as req}] (let [type-k (or - (some-> schema :juxt.grab.alpha.schema/directives (get "site") ::g/arguments (get "type") keyword) - ;; Deprecated, please don't rely on this, but rather add a directive to - ;; your schema: schema @site(type: "juxt.site/type") - :juxt.site/type)] + (some-> schema :juxt.grab.alpha.schema/directives (get "site") ::g/arguments (get "type") keyword) + ;; Deprecated, please don't rely on this, but rather add a directive to + ;; your schema: schema @site(type: "juxt.site/type") + :juxt.site/type)] (execute-request - {:schema schema - :document document - :operation-name operation-name - :variable-values variable-values - :abstract-type-resolver - (fn [{:keys [object-value]}] - (get object-value type-k)) - :field-resolver - (fn [{:keys [object-type object-value field-name argument-values] - :as field-resolver-args}] - - #_(when (= "SiteError" (get-in object-type [::g/name])) - (def object-value object-value)) - - (let [types-by-name (::schema/types-by-name schema) - field (get-in object-type [::schema/fields-by-name field-name]) - site-args (get-in field [::schema/directives-by-name "site" ::g/arguments]) - field-kind (or - (-> field ::g/type-ref ::g/name types-by-name ::g/kind) - (when (-> field ::g/type-ref ::g/list-type) 'LIST) - (when (-> field ::g/type-ref ::g/non-null-type) 'NON_NULL)) - mutation? (= - (get-in schema [::schema/root-operation-type-names :mutation]) - (::g/name object-type)) - db (try - (cond - (and (not mutation?) - (get argument-values "asOf")) - (xt/db xt-node (-> argument-values - (get "asOf") - t/instant - t/inst)) - (and - (get variable-values "historicalDb") - (:_siteValidTime object-value)) - (do - (xt/db xt-node (-> object-value - :_siteValidTime - t/inst))) - :else - db) - (catch Exception _ db)) - object-id (:xt/id object-value) - ;; TODO: Protected lookup please! - lookup-entity (fn [id] (xt/entity db id)) - opts - (merge field-resolver-args - {:site-args site-args - :xt-node xt-node - :schema schema - :field field - :field-kind field-kind - :types-by-name types-by-name - :mutation? mutation? - :base-uri base-uri - :type-k type-k - :lookup-entity lookup-entity - ::pass/subject subject - :db db})] - - (cond - ;; The registration of a resolver should be a privileged operation, since it - ;; has the potential to bypass access control. - (get site-args "resolver") - (let [resolver (requiring-resolve (symbol (get site-args "resolver")))] - ;; Resolvers need to do their own access control - (resolver opts)) - - mutation? (perform-mutation! opts) - - (get site-args "history") - (if-let [id (get argument-values "id")] - (let [limit (get argument-values "limit" 10) - offset (get argument-values "offset" 0) - order (case (get site-args "history") - "desc" :desc - "asc" :asc - :desc) - process-history-item - (fn [{::xt/keys [valid-time doc]}] - (assoc doc :_siteValidTime (t/instant valid-time)))] - (with-open [history (xt/open-entity-history db id order {:with-docs? true})] - (->> history - (iterator-seq) - (drop offset) - (take limit) - (map process-history-item)))) - (throw (ex-info "History queries must have an id argument" {}))) - - ;; Direct lookup - useful for query roots - (get site-args "e") - (let [e (get site-args "e")] - (or (protected-lookup e subject db xt-node) - (protected-lookup (get argument-values e) subject db xt-node))) - - (get site-args "q") - (let [object-id (:xt/id object-value) - arg-keys (fn [m] (remove #{"limit" "offset" "orderBy"} (keys m))) - in (cond->> (map symbol (arg-keys argument-values)) - object-id (concat ['object])) - q (assoc - (to-xt-query opts) - :in (if (second in) [in] (vec in))) - - query-args (cond->> (vals argument-values) - object-id (concat [object-id])) - args (if (second query-args) query-args (first query-args)) - results - (try - (if (nil? args) - (xt/q db q) - (xt/q db q args)) + {:schema schema + :document document + :operation-name operation-name + :variable-values variable-values + :abstract-type-resolver + (fn [{:keys [object-value]}] + (get object-value type-k)) + :field-resolver + (fn [{:keys [object-type object-value field-name argument-values] + :as field-resolver-args}] + + #_(when (= "SiteError" (get-in object-type [::g/name])) + (def object-value object-value)) + + (let [types-by-name (::schema/types-by-name schema) + field (get-in object-type [::schema/fields-by-name field-name]) + site-args (get-in field [::schema/directives-by-name "site" ::g/arguments]) + field-kind (or + (-> field ::g/type-ref ::g/name types-by-name ::g/kind) + (when (-> field ::g/type-ref ::g/list-type) 'LIST) + (when (-> field ::g/type-ref ::g/non-null-type) 'NON_NULL)) + mutation? (= + (get-in schema [::schema/root-operation-type-names :mutation]) + (::g/name object-type)) + db (try + (cond + (and (not mutation?) + (get argument-values "asOf")) + (xt/db xt-node (-> argument-values + (get "asOf") + t/instant + t/inst)) + (and + (get variable-values "historicalDb") + (:_siteValidTime object-value)) + (do + (xt/db xt-node (-> object-value + :_siteValidTime + t/inst))) + :else + db) + (catch Exception _ db)) + object-id (:xt/id object-value) + lookup-entity (fn [id] (protected-lookup id subject db xt-node)) + opts + (merge field-resolver-args + {:site-args site-args + :xt-node xt-node + :schema schema + :field field + :field-kind field-kind + :types-by-name types-by-name + :mutation? mutation? + :base-uri base-uri + :type-k type-k + :lookup-entity lookup-entity + ::pass/subject subject + :db db})] + + (cond + ;; The registration of a resolver should be a privileged operation, since it + ;; has the potential to bypass access control. + (get site-args "resolver") + (let [resolver (requiring-resolve (symbol (get site-args "resolver")))] + ;; Resolvers need to do their own access control + (resolver opts)) + + mutation? (perform-mutation! opts) + + (get site-args "history") + (if-let [id (get argument-values "id")] + (let [limit (get argument-values "limit" 10) + offset (get argument-values "offset" 0) + order (case (get site-args "history") + "desc" :desc + "asc" :asc + :desc) + process-history-item + (fn [{::xt/keys [valid-time doc]}] + (assoc doc :_siteValidTime (t/instant valid-time)))] + (with-open [history (xt/open-entity-history db id order {:with-docs? true})] + (->> history + (iterator-seq) + (drop offset) + (take limit) + (map process-history-item)))) + (throw (ex-info "History queries must have an id argument" {}))) + + ;; Direct lookup - useful for query roots + (get site-args "e") + (let [e (get site-args "e")] + (or (protected-lookup e subject db xt-node) + (protected-lookup (get argument-values e) subject db xt-node))) + + (get site-args "q") + (let [object-id (:xt/id object-value) + arg-keys (fn [m] (remove #{"limit" "offset" "orderBy"} (keys m))) + in (cond->> (map symbol (arg-keys argument-values)) + object-id (concat ['object])) + q (assoc + (to-xt-query opts) + :in (if (second in) [in] (vec in))) + + query-args (cond->> (vals argument-values) + object-id (concat [object-id])) + args (if (second query-args) query-args (first query-args)) + results + (try + (if (nil? args) + (xt/q db q) + (xt/q db q args)) - (catch Exception e - (throw (ex-info "Failure when running XTDB query" - {:message (ex-message e) - :query (pr-str q) - :args args} - e)))) - limited-results (limit-results argument-values results) - result-entities (cond->> - (pull-entities db xt-node subject limited-results q) - (get site-args "a") - (map (keyword (get site-args "a"))))] - -;;(log/tracef "GraphQL results is %s" (seq result-entities)) - - (process-xt-results field result-entities)) - - (get site-args "itemForId") - (let [item-key (keyword (get site-args "itemForId")) - query {:find ['e '_siteCreatedAt] - :where [['e type-k (field->type field)] - ['e :_siteCreatedAt '_siteCreatedAt] - ['e item-key (get argument-values "id")]]} - - query (to-xt-query (assoc opts :custom-xt-query query)) - results (xt/q db query) - result-entities (cond->> (pull-entities db xt-node subject results query) - (get site-args "a") - (map (keyword (get site-args "a"))))] - (vec (process-xt-results field result-entities))) - - (get site-args "a") - (let [att (get site-args "a") - val (if (vector? att) - (traverse object-value att subject db xt-node) - (get object-value (keyword att))) - transform-sym (some-> site-args (get "transform") symbol) - transform (when transform-sym (requiring-resolve transform-sym))] - (if (= field-kind 'OBJECT) - (protected-lookup val subject db xt-node) - ;; TODO: check for lists - (cond-> val - transform transform))) - - (get site-args "ref") - (let [list? (list-type? (::g/type-ref field)) - ref (get site-args "ref") - e (or - (and (vector? ref) - (traverse object-value ref subject db xt-node)) - (get object-value ref) - (get object-value (keyword ref))) - lookup-entity #(protected-lookup % subject db xt-node) - type (field->type field)] - (if e - ;; referenced key exists on current entity - (lookup-entity e) - ;; try a query for any other entity which contains - ;; the reference key (reverse join) - (let [reverse-lookup-result - (xt/q db {:find ['e] - :where [['e type-k type] - ['e (keyword ref) (or - (get argument-values ref) - object-id)]]})] - (if list? - (map (comp lookup-entity first) reverse-lookup-result) - (lookup-entity (ffirst reverse-lookup-result)))))) - - (get site-args "each") - (let [att (get site-args "each") - val (if (vector? att) - (traverse object-value att subject db xt-node) - (get object-value (keyword att)))] - (if (-> field ::g/type-ref list-type?) - (map #(protected-lookup % subject db xt-node) val) - (throw (ex-info "Can only used 'each' on a LIST type" {:field-kind field-kind})))) - - (get site-args "siteResolver") - (let [resolver - (case (get site-args "siteResolver") - "allQueryParams" - (requiring-resolve 'juxt.site.alpha.graphql-resolver/query-parameters) - "queryParam" - (requiring-resolve 'juxt.site.alpha.graphql-resolver/query-parameter) - "queryString" - (requiring-resolve 'juxt.site.alpha.graphql-resolver/query-string) - "constant" - (requiring-resolve 'juxt.site.alpha.graphql-resolver/constant) - (throw (ex-info "No such built-in resolver" {:site-resolver (get site-args "siteResolver")})))] - (resolver (assoc field-resolver-args ::site/request-context req))) - - ;; A function whose input is the result of a GraphqL 'sub' query, - ;; propagating the same subject and under the exact same access - ;; control policy. This allows the function to declare its necessary - ;; inputs as a query. - ;; - ;; In addition, a function's results may be memoized, with each result - ;; stored in XTDB which acts as a large persistent memoization - ;; cache. For this reason, the function must be pure. The function - ;; must take a single map which contains the results of the sub-query - ;; and any argument values (which would also be used as variable - ;; values in the GraphQL sub-query which computes the other input - ;; argument). - ;; - ;; Once this feature is working, replace it with a call to a lambda or - ;; similarly sandboxed execution environment. - (get site-args "function") - (throw (ex-info "Feature not yet supported" {})) - - (and (= 1 (count argument-values)) - (= "id" (ffirst argument-values))) - (lookup-entity (get argument-values "id")) - - (and (= 1 (count argument-values)) - (= "ids" (ffirst argument-values))) - (map lookup-entity (get argument-values "ids")) - - ;; Another strategy is to see if the field indexes the - ;; object-value. This strategy allows for delays to be used to prevent - ;; computing field values that aren't resolved. - (and (map? object-value) (contains? object-value field-name)) - (let [f (force (get object-value field-name))] - (if (fn? f) (f argument-values) f)) - - ;; If the key is 'id', we assume it should be translated to xt/id - (= "id" field-name) - (get object-value :xt/id) - - ;; Or simply try to extract the keyword - (and (map? object-value) - (or - ;; schema specifies this field is on the object - (get-in field [::schema/directives-by-name "onObject"]) - (contains? object-value (keyword field-name)))) - (let [result (get object-value (keyword field-name))] - (cond - (-> field ::g/type-ref list-type?) - (limit-results argument-values result) - ;; TODO validate enum (enum? (field->type field) types-by-name) - :else - result)) - - (and (field->type field) - (not (scalar? (field->type field) types-by-name)) - (not (enum? (field->type field) types-by-name))) - (infer-query db - xt-node - subject - field - (to-xt-query opts)) - - (get argument-values "id") - (xt/entity db (get argument-values "id")) - - (and (get site-args "aggregate") - (get site-args "type")) - (case (get site-args "aggregate") - "count" (count - (xt/q - db (to-xt-query opts)))) - - (= "_siteValidTime" field-name) - (entity-valid-time object-value db) - - (= "_siteCreatedAt" field-name) - (entity-creation-time object-value db) - - :else - (default-for-type (::g/type-ref field)))))}))) + (catch Exception e + (throw (ex-info "Failure when running XTDB query" + {:message (ex-message e) + :query (pr-str q) + :args args} + e)))) + limited-results (limit-results argument-values results) + result-entities (cond->> + (pull-entities db xt-node subject limited-results q) + (get site-args "a") + (map (keyword (get site-args "a"))))] + + ;;(log/tracef "GraphQL results is %s" (seq result-entities)) + + (process-xt-results field result-entities)) + + (get site-args "itemForId") + (let [item-key (keyword (get site-args "itemForId")) + query {:find ['e '_siteCreatedAt] + :where [['e type-k (field->type field)] + ['e :_siteCreatedAt '_siteCreatedAt] + ['e item-key (get argument-values "id")]]} + + query (to-xt-query (assoc opts :custom-xt-query query)) + results (xt/q db query) + result-entities (cond->> (pull-entities db xt-node subject results query) + (get site-args "a") + (map (keyword (get site-args "a"))))] + (vec (process-xt-results field result-entities))) + + (get site-args "a") + (let [att (get site-args "a") + val (if (vector? att) + (traverse object-value att subject db xt-node) + (get object-value (keyword att))) + transform-sym (some-> site-args (get "transform") symbol) + transform (when transform-sym (requiring-resolve transform-sym))] + (if (= field-kind 'OBJECT) + (protected-lookup val subject db xt-node) + ;; TODO: check for lists + (cond-> val + transform transform))) + + (get site-args "ref") + (let [list? (list-type? (::g/type-ref field)) + ref (get site-args "ref") + e (or + (and (vector? ref) + (traverse object-value ref subject db xt-node)) + (get object-value ref) + (get object-value (keyword ref))) + lookup-entity #(protected-lookup % subject db xt-node) + type (field->type field)] + (if e + ;; referenced key exists on current entity + (lookup-entity e) + ;; try a query for any other entity which contains + ;; the reference key (reverse join) + (let [reverse-lookup-result + (xt/q db {:find ['e] + :where [['e type-k type] + ['e (keyword ref) (or + (get argument-values ref) + object-id)]]})] + (if list? + (map (comp lookup-entity first) reverse-lookup-result) + (lookup-entity (ffirst reverse-lookup-result)))))) + + (get site-args "each") + (let [att (get site-args "each") + val (if (vector? att) + (traverse object-value att subject db xt-node) + (get object-value (keyword att)))] + (if (-> field ::g/type-ref list-type?) + (map #(protected-lookup % subject db xt-node) val) + (throw (ex-info "Can only used 'each' on a LIST type" {:field-kind field-kind})))) + + (get site-args "siteResolver") + (let [resolver + (case (get site-args "siteResolver") + "allQueryParams" + (requiring-resolve 'juxt.site.alpha.graphql-resolver/query-parameters) + "queryParam" + (requiring-resolve 'juxt.site.alpha.graphql-resolver/query-parameter) + "queryString" + (requiring-resolve 'juxt.site.alpha.graphql-resolver/query-string) + "constant" + (requiring-resolve 'juxt.site.alpha.graphql-resolver/constant) + (throw (ex-info "No such built-in resolver" {:site-resolver (get site-args "siteResolver")})))] + (resolver (assoc field-resolver-args ::site/request-context req))) + + ;; A function whose input is the result of a GraphqL 'sub' query, + ;; propagating the same subject and under the exact same access + ;; control policy. This allows the function to declare its necessary + ;; inputs as a query. + ;; + ;; In addition, a function's results may be memoized, with each result + ;; stored in XTDB which acts as a large persistent memoization + ;; cache. For this reason, the function must be pure. The function + ;; must take a single map which contains the results of the sub-query + ;; and any argument values (which would also be used as variable + ;; values in the GraphQL sub-query which computes the other input + ;; argument). + ;; + ;; Once this feature is working, replace it with a call to a lambda or + ;; similarly sandboxed execution environment. + (get site-args "function") + (throw (ex-info "Feature not yet supported" {})) + + (and (= 1 (count argument-values)) + (= "id" (ffirst argument-values))) + (lookup-entity (get argument-values "id")) + + (and (= 1 (count argument-values)) + (= "ids" (ffirst argument-values))) + (map lookup-entity (get argument-values "ids")) + + ;; Another strategy is to see if the field indexes the + ;; object-value. This strategy allows for delays to be used to prevent + ;; computing field values that aren't resolved. + (and (map? object-value) (contains? object-value field-name)) + (let [f (force (get object-value field-name))] + (if (fn? f) (f argument-values) f)) + + ;; If the key is 'id', we assume it should be translated to xt/id + (= "id" field-name) + (get object-value :xt/id) + + ;; Or simply try to extract the keyword + (and (map? object-value) + (or + ;; schema specifies this field is on the object + (get-in field [::schema/directives-by-name "onObject"]) + (contains? object-value (keyword field-name)))) + (let [result (get object-value (keyword field-name))] + (cond + (-> field ::g/type-ref list-type?) + (limit-results argument-values result) + ;; TODO validate enum (enum? (field->type field) types-by-name) + :else + result)) + + (and (field->type field) + (not (scalar? (field->type field) types-by-name)) + (not (enum? (field->type field) types-by-name))) + (infer-query db + xt-node + subject + field + (to-xt-query opts)) + + (get argument-values "id") + (xt/entity db (get argument-values "id")) + + (and (get site-args "aggregate") + (get site-args "type")) + (case (get site-args "aggregate") + "count" (count + (xt/q + db (to-xt-query opts)))) + + (= "_siteValidTime" field-name) + (entity-valid-time object-value db) + + (= "_siteCreatedAt" field-name) + (entity-creation-time object-value db) + + :else + (default-for-type (::g/type-ref field)))))}))) (defn common-variables "Return the common 'built-in' variables that are bound always bound." @@ -799,9 +829,9 @@ _validate-schema (and (nil? schema) (let [msg (str "Schema does not exist at " uri ". Are you deploying it correctly?")] (throw (ex-info - msg - {::site/errors [msg] ;; TODO - ::site/request-context (assoc req :ring.response/status 400)})))) + msg + {::site/errors [msg] ;; TODO + ::site/request-context (assoc req :ring.response/status 400)})))) body (some-> req ::site/received-representation ::http/body (String.)) {query "query" @@ -811,23 +841,23 @@ "application/json" (try (some-> body json/read-value) (catch Exception e (throw - (let [msg "Error parsing JSON body"] - (ex-info - msg - {::site/errors [msg] - ::site/request-context (assoc req :ring.response/status 400)}))))) + (let [msg "Error parsing JSON body"] + (ex-info + msg + {::site/errors [msg] + ::site/request-context (assoc req :ring.response/status 400)}))))) "application/graphql" {"query" body} (throw - (ex-info - (format "Unknown content type for GraphQL request: %s" (some-> req ::site/received-representation ::http/content-type)) - {::site/request-context req}))) + (ex-info + (format "Unknown content type for GraphQL request: %s" (some-> req ::site/received-representation ::http/content-type)) + {::site/request-context req}))) _ (when (nil? query) (throw - (ex-info - "Nil GraphQL query" - {::site/request-context req}))) + (ex-info + "Nil GraphQL query" + {::site/request-context req}))) parsed-query (try @@ -835,10 +865,10 @@ (catch Exception e (log/error e "Error parsing GraphQL query") (throw - (ex-info - "Failed to parse query" - {::site/request-context req} - e)))) + (ex-info + "Failed to parse query" + {::site/request-context req} + e)))) compiled-query (try @@ -848,24 +878,24 @@ (let [errors (:errors (ex-data e))] (log/errorf "Errors %s" (pr-str errors)) (throw - (ex-info - "Error parsing or compiling GraphQL query" - (cond-> {::site/request-context (assoc req :ring.response/status 400)} - (seq errors) (assoc ::grab/errors errors))))))) + (ex-info + "Error parsing or compiling GraphQL query" + (cond-> {::site/request-context (assoc req :ring.response/status 400)} + (seq errors) (assoc ::grab/errors errors))))))) variables (into - (common-variables req) - variables) + (common-variables req) + variables) results (juxt.site.alpha.graphql/query - schema compiled-query operation-name variables req)] + schema compiled-query operation-name variables req)] (-> req (assoc - :ring.response/status 200 - :ring.response/body - (json/write-value-as-string results)) + :ring.response/status 200 + :ring.response/body + (json/write-value-as-string results)) (update :ring.response/headers assoc "content-type" "application/json")))) (defn schema-resource [resource schema-str] @@ -874,28 +904,28 @@ (defn put-schema [xt-node resource schema-str] (xt/await-tx - xt-node - (xt/submit-tx xt-node - [[:xtdb.api/put (schema-resource resource schema-str)]]))) + (xt/submit-tx + xt-node + [[:xtdb.api/put (schema-resource resource schema-str)]]))) (defn put-handler [{::site/keys [uri db xt-node] :as req}] (let [schema-str (some-> req :juxt.site.alpha/received-representation :juxt.http.alpha/body (String.)) _ (when-not schema-str (throw - (ex-info - "No schema in request" - {::site/request-context {:ring.response/status 400}}))) + (ex-info + "No schema in request" + {::site/request-context {:ring.response/status 400}}))) resource (xt/entity db uri)] (when (nil? resource) (throw - (ex-info - "GraphQL resource not configured" - {:uri uri - ::site/request-context (assoc req :ring.response/status 400)}))) + (ex-info + "GraphQL resource not configured" + {:uri uri + ::site/request-context (assoc req :ring.response/status 400)}))) (try (put-schema xt-node resource schema-str) @@ -904,65 +934,65 @@ (let [errors (:errors (ex-data e))] (if (seq errors) (throw - (ex-info - "Errors in schema" - (cond-> {::site/request-context (assoc req :ring.response/status 400)} - (seq errors) (assoc ::grab/errors errors)))) + (ex-info + "Errors in schema" + (cond-> {::site/request-context (assoc req :ring.response/status 400)} + (seq errors) (assoc ::grab/errors errors)))) (throw - (ex-info - "Failed to put schema" - {::site/request-context (assoc req :ring.response/status 500)} - e)))))))) + (ex-info + "Failed to put schema" + {::site/request-context (assoc req :ring.response/status 500)} + e)))))))) (defn plain-text-error-message [error] (let [line (some-> error :location :line inc)] (str - (when line (format "%4d: " line)) - (:message error) - " [" (->> (dissoc error :message) - sort - (map (fn [[k v]] (format "%s=%s" (name k) v))) - (str/join ", ")) "]"))) + (when line (format "%4d: " line)) + (:message error) + " [" (->> (dissoc error :message) + sort + (map (fn [[k v]] (format "%s=%s" (name k) v))) + (str/join ", ")) "]"))) (defn put-error-text-body [req] (cond (::site/errors req) (->> - (for [error (::site/errors req)] - (cond-> (str \tab (plain-text-error-message error)) - ;;(:location error) (str " (line " (-> error :location :line) ")") - )) - (into ["Schema compilation errors"]) - (str/join (System/lineSeparator))) + (for [error (::site/errors req)] + (cond-> (str \tab (plain-text-error-message error)) + ;;(:location error) (str " (line " (-> error :location :line) ")") + )) + (into ["Schema compilation errors"]) + (str/join (System/lineSeparator))) (:ring.response/body req) (:ring.response/body req) :else "Unknown error, check stack trace")) (defn put-error-json-body [req] (json/write-value-as-string - {:message "Schema compilation errors" - :errors (::site/errors req)})) + {:message "Schema compilation errors" + :errors (::site/errors req)})) (defn post-error-text-body [req] (->> - (for [error (::site/errors req)] - (cond-> (str \tab (:error error)) - (:location error) (str " (line " (-> error :location :row inc) ")"))) - (into ["Query errors"]) - (str/join (System/lineSeparator)))) + (for [error (::site/errors req)] + (cond-> (str \tab (:error error)) + (:location error) (str " (line " (-> error :location :row inc) ")"))) + (into ["Query errors"]) + (str/join (System/lineSeparator)))) (defn post-error-json-body [req] (json/write-value-as-string - {:errors - (for [error (::site/errors req) - :let [location (:location error)]] - (cond-> error - location (assoc :location location)))})) + {:errors + (for [error (::site/errors req) + :let [location (:location error)]] + (cond-> error + location (assoc :location location)))})) (defn stored-document-resource-map [document-str schema] (try (let [document (document/compile-document - (parser/parse document-str) - schema)] + (parser/parse document-str) + schema)] {::site/graphql-compiled-query document ::http/body (.getBytes document-str) @@ -972,75 +1002,75 @@ (let [errors (:errors (ex-data e))] (if (seq errors) (throw - (ex-info - "Errors in GraphQL document" - {::grab/errors errors})) + (ex-info + "Errors in GraphQL document" + {::grab/errors errors})) (throw - (ex-info - "Failed to store GraphQL document due to error" - {} - e))))))) + (ex-info + "Failed to store GraphQL document due to error" + {} + e))))))) (defn stored-document-put-handler [{::site/keys [uri db xt-node] :as req}] (let [document-str (some-> req :juxt.site.alpha/received-representation :juxt.http.alpha/body (String.)) _ (when-not document-str (throw - (ex-info - "No document in request" - {::site/request-context (assoc req :ring.response/status 400)}))) + (ex-info + "No document in request" + {::site/request-context (assoc req :ring.response/status 400)}))) resource (xt/entity db uri)] (when (nil? resource) (throw - (ex-info - "GraphQL stored-document resource not configured" - {:uri uri - ::site/request-context (assoc req :ring.response/status 400)}))) + (ex-info + "GraphQL stored-document resource not configured" + {:uri uri + ::site/request-context (assoc req :ring.response/status 400)}))) ;; Validate resource (when-not (::site/graphql-schema resource) (throw - (ex-info - "Resource should have a :juxt.site.alpha/graphql-schema key" - {::site/resource resource - ::site/request-context (assoc req :ring.response/status 500)}))) + (ex-info + "Resource should have a :juxt.site.alpha/graphql-schema key" + {::site/resource resource + ::site/request-context (assoc req :ring.response/status 500)}))) (let [schema-id (::site/graphql-schema resource) schema (some-> db (xt/entity schema-id) ::site/graphql-compiled-schema)] (when-not schema (throw - (ex-info - "Cannot store a GraphQL document when the schema hasn't been added" - {::site/graph-schema schema-id - ::site/request-context (assoc req :ring.response/status 500)}))) + (ex-info + "Cannot store a GraphQL document when the schema hasn't been added" + {::site/graph-schema schema-id + ::site/request-context (assoc req :ring.response/status 500)}))) (try (let [m (stored-document-resource-map document-str schema)] (xt/await-tx - xt-node - (xt/submit-tx xt-node - [[:xtdb.api/put (into resource m)]]))) + (xt/submit-tx + xt-node + [[:xtdb.api/put (into resource m)]]))) (assoc req :ring.response/status 204) (catch clojure.lang.ExceptionInfo e (if-let [errors (::grab/errors (ex-data e))] (throw - ;; Throw but ignore the cause (since we pull out the key - ;; information from it) - (ex-info - "Errors in GraphQL document" - (cond-> {::site/request-context (assoc req :ring.response/status 400)} - (seq errors) (assoc ::grab/errors errors)))) + ;; Throw but ignore the cause (since we pull out the key + ;; information from it) + (ex-info + "Errors in GraphQL document" + (cond-> {::site/request-context (assoc req :ring.response/status 400)} + (seq errors) (assoc ::grab/errors errors)))) (throw - (ex-info - "Failed to store GraphQL document due to error" - {::site/request-context (assoc req :ring.response/status 500)} - e)))))))) + (ex-info + "Failed to store GraphQL document due to error" + {::site/request-context (assoc req :ring.response/status 500)} + e)))))))) (defn graphql-query [{::site/keys [db] :as req} stored-query-id operation-name variables] (assert stored-query-id) @@ -1048,10 +1078,10 @@ (let [resource (xt/entity db stored-query-id) _ (when-not resource (throw - (ex-info - "GraphQL stored query not found" - {:stored-query-id stored-query-id - ::site/request-context (assoc req :ring.response/status 500)}))) + (ex-info + "GraphQL stored query not found" + {:stored-query-id stored-query-id + ::site/request-context (assoc req :ring.response/status 500)}))) schema-id (::site/graphql-schema resource) diff --git a/src/juxt/site/alpha/graphql_resolver.clj b/src/juxt/site/alpha/graphql_resolver.clj index 51964dfa3..29e103dcd 100644 --- a/src/juxt/site/alpha/graphql_resolver.clj +++ b/src/juxt/site/alpha/graphql_resolver.clj @@ -34,10 +34,10 @@ ;; Set empty strings to "true" rather than empty-string, to enable selmer ;; truthy on 'if'. (reduce-kv - (fn [acc k v] - (assoc acc k (if (str/blank? v) "true" v))) - {} - form)))) + (fn [acc k v] + (assoc acc k (if (str/blank? v) "true" v))) + {} + form)))) (defn query-parameters [args] (mapv (fn [[k v]] {"name" k "value" v}) (form args))) @@ -53,8 +53,8 @@ (defn df [dir] (when-let [out (:out (sh/sh "df" "--output=avail" dir))] (Long/parseLong - (str/trim - (second (str/split out #"\n")))))) + (str/trim + (second (str/split out #"\n")))))) (defn tx-log-avail []) @@ -76,8 +76,8 @@ (defn apis [{:keys [db]}] (let [openapis (for [[uri api] (xt/q - db '{:find [openapi-uri openapi] - :where [[openapi-uri :juxt.apex.alpha/openapi openapi]]})] + db '{:find [openapi-uri openapi] + :where [[openapi-uri :juxt.apex.alpha/openapi openapi]]})] {:xt/id uri :type "OPENAPI" :contents api}) @@ -126,18 +126,18 @@ (let [node (:juxt.site.alpha.db/xt-node system) status (xt/status node)] (merge - (set/rename-keys - status - {:xtdb.version/version "version" - :xtdb.version/revision "revision" - :xtdb.index/index-version "indexVersion" - :xtdb.kv/kv-store "kvStore" - :xtdb.kv/estimate-num-keys "estimateNumKeys" - :xtdb.kv/size "kvSize"}) - {"attributeStats" - (fn [_] - (for [[name frequency] (xt/attribute-stats node)] - {"attribute" (str name) "frequency" frequency}))}))) + (set/rename-keys + status + {:xtdb.version/version "version" + :xtdb.version/revision "revision" + :xtdb.index/index-version "indexVersion" + :xtdb.kv/kv-store "kvStore" + :xtdb.kv/estimate-num-keys "estimateNumKeys" + :xtdb.kv/size "kvSize"}) + {"attributeStats" + (fn [_] + (for [[name frequency] (xt/attribute-stats node)] + {"attribute" (str name) "frequency" frequency}))}))) "version" {"gitSha" (fn [_] (git-sha))} @@ -153,22 +153,22 @@ (defn extract-errors-resolver [args] (some->> - args - :object-value - :juxt.site.alpha/errors - (map (fn [error] - (let [ex-data (:ex-data error) - graphql-type-name (::site/graphql-type ex-data "SiteGeneralError")] - (into - (into error {::site/graphql-type graphql-type-name}) - (case graphql-type-name - "SiteGraphqlExecutionError" - (select-keys ex-data [::site/graphql-stored-query-resource-path - ::site/graphql-operation-name - ::site/graphql-variables - ::grab/errors]) - {} - ))))))) + args + :object-value + :juxt.site.alpha/errors + (map (fn [error] + (let [ex-data (:ex-data error) + graphql-type-name (::site/graphql-type ex-data "SiteGeneralError")] + (into + (into error {::site/graphql-type graphql-type-name}) + (case graphql-type-name + "SiteGraphqlExecutionError" + (select-keys ex-data [::site/graphql-stored-query-resource-path + ::site/graphql-operation-name + ::site/graphql-variables + ::grab/errors]) + {} + ))))))) (defn graphql-errors [args] (for [error (some-> args :object-value ::grab/errors)] diff --git a/src/juxt/site/alpha/handler.clj b/src/juxt/site/alpha/handler.clj index 9307189a5..670253934 100644 --- a/src/juxt/site/alpha/handler.clj +++ b/src/juxt/site/alpha/handler.clj @@ -46,11 +46,11 @@ response header value, and others." [methods upper-case?] (->> - methods - seq - distinct - (map (comp (if upper-case? str/upper-case identity) name)) - (str/join ", "))) + methods + seq + distinct + (map (comp (if upper-case? str/upper-case identity) name)) + (str/join ", "))) (defn receive-representation "Check and load the representation enclosed in the request message payload." @@ -59,20 +59,20 @@ (let [content-length (try (some-> - (get-in req [:ring.request/headers "content-length"]) - (Long/parseLong)) + (get-in req [:ring.request/headers "content-length"]) + (Long/parseLong)) (catch NumberFormatException e (throw - (ex-info - "Bad content length" - {::site/request-context (assoc req :ring.response/status 400)} - e))))] + (ex-info + "Bad content length" + {::site/request-context (assoc req :ring.response/status 400)} + e))))] (when (nil? content-length) (throw - (ex-info - "No Content-Length header found" - {::site/request-context (assoc req :ring.response/status 411)}))) + (ex-info + "No Content-Length header found" + {::site/request-context (assoc req :ring.response/status 411)}))) ;; Protects resources from PUTs that are too large. If you need to ;; exceed this limitation, explicitly declare ::spin/max-content-length in @@ -80,30 +80,30 @@ (when-let [max-content-length (get resource ::http/max-content-length (Math/pow 2 24))] ;;16MB (when (> content-length max-content-length) (throw - (ex-info - "Payload too large" - {::site/request-context (assoc req :ring.response/status 413)})))) + (ex-info + "Payload too large" + {::site/request-context (assoc req :ring.response/status 413)})))) (when-not (:ring.request/body req) (throw - (ex-info - "No body in request" - {::site/request-context (assoc req :ring.response/status 400)}))) + (ex-info + "No body in request" + {::site/request-context (assoc req :ring.response/status 400)}))) (let [decoded-representation (decode-maybe - ;; See Section 3.1.1.5, RFC 7231 as to why content-type defaults - ;; to application/octet-stream - (cond-> {::http/content-type "application/octet-stream"} - (contains? (:ring.request/headers req) "content-type") - (assoc ::http/content-type (get-in req [:ring.request/headers "content-type"])) + ;; See Section 3.1.1.5, RFC 7231 as to why content-type defaults + ;; to application/octet-stream + (cond-> {::http/content-type "application/octet-stream"} + (contains? (:ring.request/headers req) "content-type") + (assoc ::http/content-type (get-in req [:ring.request/headers "content-type"])) - (contains? (:ring.request/headers req) "content-encoding") - (assoc ::http/content-encoding (get-in req [:ring.request/headers "content-encoding"])) + (contains? (:ring.request/headers req) "content-encoding") + (assoc ::http/content-encoding (get-in req [:ring.request/headers "content-encoding"])) - (contains? (:ring.request/headers req) "content-language") - (assoc ::http/content-language (get-in req [:ring.request/headers "content-language"]))))] + (contains? (:ring.request/headers req) "content-language") + (assoc ::http/content-language (get-in req [:ring.request/headers "content-language"]))))] ;; TODO: Someday there should be a functions that could be specified to ;; handle conversions as described in RFC 7231 Section 4.3.4 @@ -124,64 +124,64 @@ (cond (= (:juxt.pick.alpha/content-type-qvalue request-rep) 0.0) (throw - (ex-info - "The content-type of the request payload is not supported by the resource" - {::acceptable acceptable - ::content-type (get request-rep "content-type") - ::site/request-context (assoc req :ring.response/status 415)})) + (ex-info + "The content-type of the request payload is not supported by the resource" + {::acceptable acceptable + ::content-type (get request-rep "content-type") + ::site/request-context (assoc req :ring.response/status 415)})) (and - (= "text" (get-in request-rep [:juxt.reap.alpha.rfc7231/content-type :juxt.reap.alpha.rfc7231/type])) - (get prefs "accept-charset") - (not (contains? (get-in request-rep [:juxt.reap.alpha.rfc7231/content-type :juxt.reap.alpha.rfc7231/parameter-map]) "charset"))) + (= "text" (get-in request-rep [:juxt.reap.alpha.rfc7231/content-type :juxt.reap.alpha.rfc7231/type])) + (get prefs "accept-charset") + (not (contains? (get-in request-rep [:juxt.reap.alpha.rfc7231/content-type :juxt.reap.alpha.rfc7231/parameter-map]) "charset"))) (throw - (ex-info - "The Content-Type header in the request is a text type and is required to specify its charset as a media-type parameter" - {::acceptable acceptable - ::content-type (get request-rep "content-type") - ::site/request-context (assoc req :ring.response/status 415)})) + (ex-info + "The Content-Type header in the request is a text type and is required to specify its charset as a media-type parameter" + {::acceptable acceptable + ::content-type (get request-rep "content-type") + ::site/request-context (assoc req :ring.response/status 415)})) (= (:juxt.pick.alpha/charset-qvalue request-rep) 0.0) (throw - (ex-info - "The charset of the Content-Type header in the request is not supported by the resource" - {::acceptable acceptable - ::content-type (get request-rep "content-type") - ::site/request-context (assoc req :ring.response/status 415)})))) + (ex-info + "The charset of the Content-Type header in the request is not supported by the resource" + {::acceptable acceptable + ::content-type (get request-rep "content-type") + ::site/request-context (assoc req :ring.response/status 415)})))) (when (get prefs "accept-encoding") (cond (= (:juxt.pick.alpha/content-encoding-qvalue request-rep) 0.0) (throw - (ex-info - "The content-encoding in the request is not supported by the resource" - {::acceptable acceptable - ::content-encoding (get-in req [:ring.request/headers "content-encoding"] "identity") - ::site/request-context (assoc req :ring.response/status 409)})))) + (ex-info + "The content-encoding in the request is not supported by the resource" + {::acceptable acceptable + ::content-encoding (get-in req [:ring.request/headers "content-encoding"] "identity") + ::site/request-context (assoc req :ring.response/status 409)})))) (when (get prefs "accept-language") (cond (not (contains? (:ring.response/headers req) "content-language")) (throw - (ex-info - "Request must contain Content-Language header" - {::acceptable acceptable - ::content-language (get-in req [:ring.request/headers "content-language"]) - ::site/request-context (assoc req :ring.response/status 409)})) + (ex-info + "Request must contain Content-Language header" + {::acceptable acceptable + ::content-language (get-in req [:ring.request/headers "content-language"]) + ::site/request-context (assoc req :ring.response/status 409)})) (= (:juxt.pick.alpha/content-language-qvalue request-rep) 0.0) (throw - (ex-info - "The content-language in the request is not supported by the resource" - {::acceptable acceptable - ::content-language (get-in req [:ring.request/headers "content-language"]) - ::site/request-context (assoc req :ring.response/status 415)})))))) + (ex-info + "The content-language in the request is not supported by the resource" + {::acceptable acceptable + ::content-language (get-in req [:ring.request/headers "content-language"]) + ::site/request-context (assoc req :ring.response/status 415)})))))) (when (get-in req [:ring.request/headers "content-range"]) (throw - (ex-info - "Content-Range header not allowed on a PUT request" - {::site/request-context (assoc req :ring.response/status 400)}))) + (ex-info + "Content-Range header not allowed on a PUT request" + {::site/request-context (assoc req :ring.response/status 400)}))) (with-open [in (:ring.request/body req)] (let [body (.readNBytes in content-length) @@ -190,6 +190,7 @@ (merge decoded-representation {::http/content-length content-length + :ring.response/headers {"Cache-Control" "public, max-age=604800, immutable"} ::http/last-modified start-date} (if (and @@ -218,8 +219,8 @@ existing (xt/entity db location)] (->> (xt/submit-tx - xt-node - [[:xtdb.api/put (merge {:xt/id location} request-instance)]]) + xt-node + [[:xtdb.api/put (merge {:xt/id location} request-instance)]]) (xt/await-tx xt-node)) (into req {:ring.response/status (if existing 204 201) @@ -231,12 +232,12 @@ {::site/keys [resource]} resource-state existing (xt/entity db resource)] (->> (xt/submit-tx - xt-node - [[:xtdb.api/put - (merge - {:xt/id resource} - ;; ::site/resource = :xt/id, no need to duplicate - (dissoc resource-state ::site/resource))]]) + xt-node + [[:xtdb.api/put + (merge + {:xt/id resource} + ;; ::site/resource = :xt/id, no need to duplicate + (dissoc resource-state ::site/resource))]]) (xt/await-tx xt-node)) (into req {:ring.response/status (if existing 204 201)}))) @@ -245,8 +246,8 @@ (defn POST [{::site/keys [resource request-id] :as req}] (let [rep (-> - (receive-representation req) - (assoc ::site/request request-id)) + (receive-representation req) + (assoc ::site/request request-id)) req (assoc req ::site/received-representation rep) post-fn (::site/post-fn resource) post @@ -256,31 +257,31 @@ (symbol? post-fn) (try (or - (requiring-resolve post-fn) - (throw - (ex-info - (format "Requiring resolve of %s returned nil" post-fn) - {:post-fn post-fn - ::site/request-context (assoc req :ring.response/status 500)}))) + (requiring-resolve post-fn) + (throw + (ex-info + (format "Requiring resolve of %s returned nil" post-fn) + {:post-fn post-fn + ::site/request-context (assoc req :ring.response/status 500)}))) (catch Exception e (throw - (ex-info - (format "post-fn '%s' is not resolvable" post-fn) - {::post-fn post-fn - ::site/request-context (assoc req :ring.response/status 500)} - e)))) + (ex-info + (format "post-fn '%s' is not resolvable" post-fn) + {::post-fn post-fn + ::site/request-context (assoc req :ring.response/status 500)} + e)))) (nil? post-fn) (throw - (ex-info - "Resource allows POST but doesn't have a post-fn function" - {::site/request-context (assoc req :ring.response/status 500)})) + (ex-info + "Resource allows POST but doesn't have a post-fn function" + {::site/request-context (assoc req :ring.response/status 500)})) :else (throw - (ex-info - (format "post-fn is neither a function or a symbol, but type '%s'" (type post-fn)) - {::site/request-context (assoc req :ring.response/status 500)})))] + (ex-info + (format "post-fn is neither a function or a symbol, but type '%s'" (type post-fn)) + {::site/request-context (assoc req :ring.response/status 500)})))] (assert post) (post req))) @@ -299,33 +300,33 @@ (symbol? put-fn) (try (or - (requiring-resolve put-fn) - (throw (ex-info (format "Requiring resolve of %s returned nil" put-fn) {:put-fn put-fn}))) + (requiring-resolve put-fn) + (throw (ex-info (format "Requiring resolve of %s returned nil" put-fn) {:put-fn put-fn}))) (catch Exception e (throw - (ex-info - (format "put-fn '%s' is not resolvable" put-fn) - {::put-fn put-fn - ::site/request-context (assoc req :ring.response/status 500)} - e)))) + (ex-info + (format "put-fn '%s' is not resolvable" put-fn) + {::put-fn put-fn + ::site/request-context (assoc req :ring.response/status 500)} + e)))) (nil? put-fn) (throw - (ex-info - "Resource allows PUT but doesn't contain a put-fn function" - {::site/request-context (assoc req :ring.response/status 500)})) + (ex-info + "Resource allows PUT but doesn't contain a put-fn function" + {::site/request-context (assoc req :ring.response/status 500)})) :else (throw - (ex-info - (format "put-fn is neither a function or a symbol, but type '%s'" (type put-fn)) - {::site/request-context (assoc req :ring.response/status 500)})))] + (ex-info + (format "put-fn is neither a function or a symbol, but type '%s'" (type put-fn)) + {::site/request-context (assoc req :ring.response/status 500)})))] (if-let [response (put req)] response (throw - (ex-info - "put-fn returned a nil response" - {:put-fn put-fn - ::site/request-context (assoc req :ring.response/status 500)})))))) + (ex-info + "put-fn returned a nil response" + {:put-fn put-fn + ::site/request-context (assoc req :ring.response/status 500)})))))) (defn PATCH [{::site/keys [resource] :as req}] (let [rep (receive-representation req) _ (assert rep) @@ -337,9 +338,9 @@ (fn? patch-fn) (patch-fn req) :else (throw - (ex-info - "Resource allows PATCH but doesn't contain have a patch-fn function" - {::site/request-context (assoc req :ring.response/status 500)}))))) + (ex-info + "Resource allows PATCH but doesn't contain have a patch-fn function" + {::site/request-context (assoc req :ring.response/status 500)}))))) (defn DELETE [{::site/keys [xt-node uri] :as req}] (let [tx (xt/submit-tx xt-node [[:xtdb.api/delete uri]])] @@ -353,10 +354,10 @@ [resource-origin allow-origin] (or - (when-let [ro (get access-control-allow-origins request-origin)] - [ro request-origin]) - (when-let [ro (get access-control-allow-origins "*")] - [ro "*"])) + (when-let [ro (get access-control-allow-origins request-origin)] + [ro request-origin]) + (when-let [ro (get access-control-allow-origins "*")] + [ro "*"])) access-control-allow-methods (get resource-origin ::site/access-control-allow-methods) @@ -380,27 +381,27 @@ access-control-allow-methods (update - :ring.response/headers - (fn [headers] - (cond-> headers - allow-origin (assoc "access-control-allow-origin" allow-origin) - access-control-allow-methods (assoc "access-control-allow-methods" (join-keywords access-control-allow-methods true)) - access-control-allow-headers (assoc "access-control-allow-headers" (join-keywords access-control-allow-headers false)) - access-control-allow-credentials (assoc "access-control-allow-credentials" access-control-allow-credentials))))))) + :ring.response/headers + (fn [headers] + (cond-> headers + allow-origin (assoc "access-control-allow-origin" allow-origin) + access-control-allow-methods (assoc "access-control-allow-methods" (join-keywords access-control-allow-methods true)) + access-control-allow-headers (assoc "access-control-allow-headers" (join-keywords access-control-allow-headers false)) + access-control-allow-credentials (assoc "access-control-allow-credentials" access-control-allow-credentials))))))) (defn PROPFIND [req] (dave.methods/propfind req)) (defn MKCOL [{::site/keys [xt-node uri]}] (let [tx (xt/submit-tx - xt-node - [[:xtdb.api/put - {:xt/id uri - ::dave/resource-type :collection - ::http/methods #{:get :head :options :propfind} - ::http/content-type "text/html;charset=utf-8" - ::http/content "

Index

\r\n" - ::http/options {"DAV" "1"}}]])] + xt-node + [[:xtdb.api/put + {:xt/id uri + ::dave/resource-type :collection + ::http/methods #{:get :head :options :propfind} + ::http/content-type "text/html;charset=utf-8" + ::http/content "

Index

\r\n" + ::http/options {"DAV" "1"}}]])] (xt/await-tx xt-node tx)) {:ring.response/status 201 :ring.response/headers {}}) @@ -414,13 +415,13 @@ (defn wrap-method-not-implemented? [h] (fn [{:ring.request/keys [method] :as req}] (when-not (contains? - #{:get :head :post :put :delete :options - :patch - :mkcol :propfind} method) + #{:get :head :post :put :delete :options + :patch + :mkcol :propfind} method) (throw - (ex-info - "Method not implemented" - {::site/request-context (assoc req :ring.response/status 501)}))) + (ex-info + "Method not implemented" + {::site/request-context (assoc req :ring.response/status 501)}))) (h req))) (defn wrap-locate-resource [h] @@ -434,14 +435,14 @@ (when (= (::site/type resource) "Redirect") (let [status (case method (:get :head) 302 307)] (throw - (ex-info - "Redirect" - {:location (::site/location resource) - ::site/request-context - (-> req - (assoc :ring.response/status status) - (update :ring.response/headers - assoc "location" (::site/location resource)))})))) + (ex-info + "Redirect" + {:location (::site/location resource) + ::site/request-context + (-> req + (assoc :ring.response/status status) + (update :ring.response/headers + assoc "location" (::site/location resource)))})))) (h req))) (defn wrap-find-current-representations @@ -451,9 +452,9 @@ (let [cur-reps (seq (conneg/current-representations req))] (when (and (#{:get :head} method) (empty? cur-reps)) (throw - (ex-info - "Not Found" - {::site/request-context (assoc req :ring.response/status 404)}))) + (ex-info + "Not Found" + {::site/request-context (assoc req :ring.response/status 404)}))) (h (assoc req ::site/current-representations cur-reps))) (h req)))) @@ -463,8 +464,8 @@ (h (cond-> req (seq cur-reps) (assoc - ::site/selected-representation - (conneg/negotiate-representation req cur-reps))))))) + ::site/selected-representation + (conneg/negotiate-representation req cur-reps))))))) (defn wrap-authenticate [h] (fn [{:ring.request/keys [method] :as req}] @@ -482,12 +483,12 @@ {'subject subject 'resource (dissoc resource ::http/body ::http/content) 'request (select-keys - req - [:ring.request/headers :ring.request/method :ring.request/path - :ring.request/query :ring.request/protocol :ring.request/remote-addr - :ring.request/scheme :ring.request/server-name :ring.request/server-post - :ring.request/ssl-client-cert - ::site/uri]) + req + [:ring.request/headers :ring.request/method :ring.request/path + :ring.request/query :ring.request/protocol :ring.request/remote-addr + :ring.request/scheme :ring.request/server-name :ring.request/server-post + :ring.request/ssl-client-cert + ::site/uri]) 'representation (dissoc resource ::http/body ::http/content) 'environment {}} @@ -507,9 +508,9 @@ (not= (::pass/access authz) ::pass/approved)) (let [status (if-not (::pass/user subject) 401 403)] (throw - (ex-info - (case status 401 "Unauthorized" 403 "Forbidden") - {::site/request-context (assoc req :ring.response/status status)})))) + (ex-info + (case status 401 "Unauthorized" 403 "Forbidden") + {::site/request-context (assoc req :ring.response/status status)})))) (h req)))) (defn wrap-method-not-allowed? [h] @@ -518,15 +519,15 @@ (let [allowed-methods (set (::http/methods resource))] (when-not (contains? allowed-methods method) (throw - (ex-info - "Method not allowed" - {:method method - ::site/allowed-methods allowed-methods - ::site/request-context - (into - req - {:ring.response/status 405 - :ring.response/headers {"allow" (join-keywords allowed-methods true)}})}))) + (ex-info + "Method not allowed" + {:method method + ::site/allowed-methods allowed-methods + ::site/request-context + (into + req + {:ring.response/status 405 + :ring.response/headers {"allow" (join-keywords allowed-methods true)}})}))) (h (assoc req ::site/allowed-methods allowed-methods))) (h req)))) @@ -554,17 +555,17 @@ triggers (map first (xt/q db '{:find [rule] - :where [[rule ::site/type "Trigger"]]})) + :where [[rule ::site/type "Trigger"]]})) request-context {'subject subject 'request (select-keys - req - [:ring.request/headers :ring.request/method :ring.request/path - :ring.request/query :ring.request/protocol :ring.request/remote-addr - :ring.request/scheme :ring.request/server-name :ring.request/server-post - :ring.request/ssl-client-cert - ::site/uri]) + req + [:ring.request/headers :ring.request/method :ring.request/path + :ring.request/query :ring.request/protocol :ring.request/remote-addr + :ring.request/scheme :ring.request/server-name :ring.request/server-post + :ring.request/ssl-client-cert + ::site/uri]) 'environment {}}] (try @@ -615,9 +616,9 @@ (assoc-when-some "vary" (some-> rep ::http/vary)) (assoc-when-some "content-length" (or - (some-> rep ::http/content-length str) - (when (counted? body) - (some-> body count str)))) + (some-> rep ::http/content-length str) + (when (counted? body) + (some-> body count str)))) (assoc-when-some "content-range" (::http/content-range rep)) (assoc-when-some "trailer" (::http/trailer rep)) (assoc-when-some "transfer-encoding" (::http/transfer-encoding rep))))) @@ -637,25 +638,25 @@ redact (dissoc ::site/xt-node ::site/db :ring.request/body :ring.response/body) (util/deep-replace - (fn [form] - (cond-> form - (and (string? form) (>= (count form) 1024)) - (subs 0 1024) + (fn [form] + (cond-> form + (and (string? form) (>= (count form) 1024)) + (subs 0 1024) - (and (vector? form) (>= (count form) 64)) - (subvec 0 64) + (and (vector? form) (>= (count form) 64)) + (subvec 0 64) - (and (list? form) (>= (count form) 64)) - (#(take 64 %))))))) + (and (list? form) (>= (count form) 64)) + (#(take 64 %))))))) (defn log-request! [{:ring.request/keys [method] :as req}] (assert method) (log/infof - "%-7s %s %s %d" - (str/upper-case (name method)) - (:ring.request/path req) - (:ring.request/protocol req) - (:ring.response/status req))) + "%-7s %s %s %d" + (str/upper-case (name method)) + (:ring.request/path req) + (:ring.request/protocol req) + (:ring.response/status req))) (defn respond [{::site/keys [selected-representation start-date base-uri request-id] @@ -677,20 +678,20 @@ :ring.response/headers assoc "date" (format-http-date start-date)) - request-id - (update :ring.response/headers - assoc "site-request-id" - (cond-> request-id - ;; Not sure I like this shortening, it's inconvenient to have - ;; to prepend the base-uri each time - #_(.startsWith request-id base-uri) - #_(subs (count base-uri)))) + request-id + (update :ring.response/headers + assoc "site-request-id" + (cond-> request-id + ;; Not sure I like this shortening, it's inconvenient to have + ;; to prepend the base-uri each time + #_(.startsWith request-id base-uri) + #_(subs (count base-uri)))) - selected-representation - (update :ring.response/headers - representation-headers selected-representation body) + selected-representation + (update :ring.response/headers + representation-headers selected-representation body) - (= method :head) (dissoc :ring.response/body)))) + (= method :head) (dissoc :ring.response/body)))) (defn wrap-initialize-response [h] (fn [req] @@ -760,12 +761,12 @@ [e] (let [cause (.getCause e)] (cons - (cond-> - {:message (.getMessage e) - :stack-trace (.getStackTrace e)} - (instance? clojure.lang.ExceptionInfo e) - (assoc :ex-data (dissoc (ex-data e) ::site/request-context))) - (when cause (errors-with-causes cause))))) + (cond-> + {:message (.getMessage e) + :stack-trace (.getStackTrace e)} + (instance? clojure.lang.ExceptionInfo e) + (assoc :ex-data (dissoc (ex-data e) ::site/request-context))) + (when cause (errors-with-causes cause))))) (defn put-error-representation "If method is PUT" @@ -773,10 +774,10 @@ (let [{::http/keys [put-error-representations]} resource put-error-representations (filter - (fn [rep] - (if-some [applies-to (:ring.response/status rep)] - (= applies-to status) - true)) put-error-representations)] + (fn [rep] + (if-some [applies-to (:ring.response/status rep)] + (= applies-to status) + true)) put-error-representations)] (when (seq put-error-representations) (some-> (conneg/negotiate-representation req put-error-representations) @@ -789,10 +790,10 @@ (let [{::http/keys [post-error-representations]} resource post-error-representations (filter - (fn [rep] - (if-some [applies-to (:ring.response/status rep)] - (= applies-to status) - true)) post-error-representations)] + (fn [rep] + (if-some [applies-to (:ring.response/status rep)] + (= applies-to status) + true)) post-error-representations)] (when (seq post-error-representations) (some-> (conneg/negotiate-representation req post-error-representations) @@ -819,10 +820,11 @@ variables to determine the resource to use." [{::site/keys [db]} status] (when-let [res (ffirst - (q db '{:find [(pull er [*])] - :where [[er ::site/type "ErrorResource"] - [er :ring.response/status status]] - :in [status]} status))] + (xt/q db '{:find [(pull er [*])] + :where [[er ::site/type "ErrorResource"] + [er :ring.response/status status]] + :in [status]} status))] + (log/tracef "ErrorResource found for status %d: %s" status res) res)) @@ -854,9 +856,9 @@ error-representations (conneg/current-representations - (assoc req - ::site/resource er - ::site/uri (:xt/id er)))] + (assoc req + ::site/resource er + ::site/uri (:xt/id er)))] (when (seq error-representations) (some-> (conneg/negotiate-representation req error-representations) @@ -869,11 +871,7 @@ ;; TODO: Negotiate a better format for internal server errors - (let [default-body - (str "\r\n" - (cond-> "

Internal Server Error

\r\n" - request-id (str (format "

%s

\r\n" request-id "Error"))) - "\r\n")] + (let [default-body request-id] (respond (into req @@ -881,7 +879,7 @@ :ring.response/body default-body ::site/errors (errors-with-causes e) ::site/selected-representation - {::http/content-type "text/html;charset=utf-8" + {::http/content-type "text/plain;charset=utf-8" ::http/content-length (count default-body) :ring.response/body default-body} })))) @@ -918,6 +916,7 @@ {::http/content-type "text/html;charset=utf-8" ::http/content-length (count content) ::http/content content}) + (let [content (str (status-message status) ;; For text/plain we might be using the site tool. Here, @@ -934,15 +933,15 @@ (dissoc ::http/vary))) error-resource (merge - {:ring.response/status 500 - ::site/errors (errors-with-causes e)} - (dissoc req ::site/request-context) - ;; For the error itself - {::site/selected-representation representation}) + {:ring.response/status 500 + ::site/errors (errors-with-causes e)} + (dissoc req ::site/request-context) + ;; For the error itself + {::site/selected-representation representation}) error-resource (assoc - error-resource - ::site/status-message (status-message (:ring.response/status error-resource))) + error-resource + ::site/status-message (status-message (:ring.response/status error-resource))) response (try (response/add-payload error-resource) @@ -987,8 +986,8 @@ (error-response rc e)) (error-response - req - (ex-info "ExceptionInfo caught, but with an invalid request-context attached" {::site/request-context rc} e))))) + req + (ex-info "ExceptionInfo caught, but with an invalid request-context attached" {::site/request-context rc} e))))) (catch Throwable t (respond-internal-error req t)) (finally (org.slf4j.MDC/clear))))) @@ -1019,7 +1018,7 @@ (defn new-request-id [base-uri] (str base-uri "/_site/requests/" (subs (util/hexdigest - (.getBytes (str (java.util.UUID/randomUUID)) "US-ASCII")) 0 24))) + (.getBytes (str (java.util.UUID/randomUUID)) "US-ASCII")) 0 24))) (defn normalize-path "Normalize path prior to constructing URL used for resource lookup. This is to @@ -1058,28 +1057,28 @@ scheme+authority (or uri-prefix (-> - (let [{::rfc7230/keys [host]} - (host-header-parser - (re/input - (or - (get-in req [:ring.request/headers "x-forwarded-host"]) - (get-in req [:ring.request/headers "host"]))))] - (str (or (get-in req [:ring.request/headers "x-forwarded-proto"]) - (name scheme)) - "://" host)) - (str/lower-case) ; See Section 6.2.2.1 of RFC 3986 - (http-scheme-normalize scheme))) + (let [{::rfc7230/keys [host]} + (host-header-parser + (re/input + (or + (get-in req [:ring.request/headers "x-forwarded-host"]) + (get-in req [:ring.request/headers "host"]))))] + (str (or (get-in req [:ring.request/headers "x-forwarded-proto"]) + (name scheme)) + "://" host)) + (str/lower-case) ; See Section 6.2.2.1 of RFC 3986 + (http-scheme-normalize scheme))) ;; The scheme+authority is already normalized (by transforming to ;; lower-case). The path, however, needs to be normalized here. uri (str scheme+authority (normalize-path (:ring.request/path req))) req (into req (merge - {::site/start-date (java.util.Date.) - ::site/request-id req-id - ::site/uri uri - ::site/db db} - (dissoc opts ::site/uri-prefix)))] + {::site/start-date (java.util.Date.) + ::site/request-id req-id + ::site/uri uri + ::site/db db} + (dissoc opts ::site/uri-prefix)))] ;; The Ring request map becomes the container for all state collected ;; along the request processing pathway. @@ -1106,15 +1105,15 @@ :ssl-client-cert :ring.request/ssl-client-cert}] (-> (reduce-kv - (fn [acc k v] - (let [k2 (get mp k)] - (cond-> acc k2 (assoc k2 v)))) - {} req) + (fn [acc k v] + (let [k2 (get mp k)] + (cond-> acc k2 (assoc k2 v)))) + {} req) (h) (select-keys - [:ring.response/status - :ring.response/headers - :ring.response/body]) + [:ring.response/status + :ring.response/headers + :ring.response/body]) (set/rename-keys {:ring.response/status :status :ring.response/headers :headers :ring.response/body :body}))))) @@ -1133,15 +1132,15 @@ (let [{:ring.request/keys [method] ::site/keys [xt-node]} req] (when (or (= method :post) (= method :put)) (xt/submit-tx - xt-node - [[:xtdb.api/put (-> req ->storable - (select-keys [:juxt.pass.alpha/subject - ::site/date - ::site/uri - :ring.request/method - :ring.response/status]) - (assoc :xt/id req-id - ::site/type "Request"))]])))) + xt-node + [[:xtdb.api/put (-> req ->storable + (select-keys [:juxt.pass.alpha/subject + ::site/date + ::site/uri + :ring.request/method + :ring.response/status]) + (assoc :xt/id req-id + ::site/type "Request"))]])))) req))) (defn wrap-log-request [h] @@ -1167,12 +1166,12 @@ (fn [req] (when-not (service-available? req) (throw - (ex-info - "Service unavailable" - {::site/request-context - (-> req - (into {:ring.response/status 503}) - (assoc-in [:ring.response/headers "retry-after"] "120"))}))) + (ex-info + "Service unavailable" + {::site/request-context + (-> req + (into {:ring.response/status 503}) + (assoc-in [:ring.response/headers "retry-after"] "120"))}))) (h req))) (def cors-headers diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 0dca3f310..0ce5d8fb2 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -62,16 +62,16 @@ (defn e [id] (postwalk - (fn [x] (if (and (vector? x) - (#{::http/content ::http/body} (first x)) - (> (count (second x)) 1024)) + (fn [x] (if (and (vector? x) + (#{::http/content ::http/body} (first x)) + (> (count (second x)) 1024)) - [(first x) - (cond - (= ::http/content (first x)) (str (subs (second x) 0 80) "…") - :else (format "(%d bytes)" (count (second x))))] - x)) - (xt/entity (db) id))) + [(first x) + (cond + (= ::http/content (first x)) (str (subs (second x) 0 80) "…") + :else (format "(%d bytes)" (count (second x))))] + x)) + (xt/entity (db) id))) (defn hist [id] (xt/entity-history (db) id :asc {:with-docs? true})) @@ -80,44 +80,44 @@ (defn put! [& ms] (->> - (xt/submit-tx - (xt-node) - (for [m ms] - (let [vt (:xtdb.api/valid-time m)] - [:xtdb.api/put (dissoc m :xtdb.api/valid-time) vt]))) - (xt/await-tx (xt-node)))) + (xt/submit-tx + (xt-node) + (for [m ms] + (let [vt (:xtdb.api/valid-time m)] + [:xtdb.api/put (dissoc m :xtdb.api/valid-time) vt]))) + (xt/await-tx (xt-node)))) (defn grep [re coll] (filter #(re-matches (re-pattern re) %) coll)) (defn rm! [& ids] (->> - (xt/submit-tx - (xt-node) - (for [id ids] - [:xtdb.api/delete id])) - (xt/await-tx (xt-node)))) + (xt/submit-tx + (xt-node) + (for [id ids] + [:xtdb.api/delete id])) + (xt/await-tx (xt-node)))) (defn evict! [& ids] (->> - (xt/submit-tx - (xt-node) - (for [id ids] - [:xtdb.api/evict id])) - (xt/await-tx (xt-node)))) + (xt/submit-tx + (xt-node) + (for [id ids] + [:xtdb.api/evict id])) + (xt/await-tx (xt-node)))) (defn q [query & args] (apply xt/q (db) query args)) (defn t [t] (map - first - (xt/q (db) '{:find [e] :where [[e ::site/type t]] :in [t]} t))) + first + (xt/q (db) '{:find [e] :where [[e ::site/type t]] :in [t]} t))) (defn t* [t] (map - first - (xt/q (db) '{:find [e] :where [[e :type t]] :in [t]} t))) + first + (xt/q (db) '{:find [e] :where [[e :type t]] :in [t]} t))) (defn types [] (->> (q '{:find [t] @@ -156,18 +156,18 @@ (defn now-id [] (.format - (.withZone - (java.time.format.DateTimeFormatter/ofPattern "yyyy-MM-dd-HHmmss") - (java.time.ZoneId/systemDefault)) - (java.time.Instant/now))) + (.withZone + (java.time.format.DateTimeFormatter/ofPattern "yyyy-MM-dd-HHmmss") + (java.time.ZoneId/systemDefault)) + (java.time.Instant/now))) ;; Start import at 00:35 (defn resources-from-stream [in] (let [record (try (edn/read - {:eof :eof :readers edn-readers} - in) + {:eof :eof :readers edn-readers} + in) (catch Exception e (def in in) (prn (.getMessage e))))] @@ -214,8 +214,8 @@ (defn validate-resource-line [s] (edn/read-string - {:eof :eof :readers edn-readers} - s)) + {:eof :eof :readers edn-readers} + s)) (defn get-zipped-output-stream [] (let [zos (doto @@ -231,18 +231,18 @@ ;; Create a regex pattern which detects anything as a mapping key (let [pat (re-pattern (str/join "|" (map #(format "\\Q%s\\E" %) (keys mapping))))] (postwalk - (fn [s] - (cond-> s - (string? s) - (str/replace pat (fn [x] (get mapping x))))) - ent)))) + (fn [s] + (cond-> s + (string? s) + (str/replace pat (fn [x] (get mapping x))))) + ent)))) (comment (export-resources - {:pred (fn [x] (or (= (:juxt.home/type x) "Person"))) - :filename "/home/mal/Sync/persons.edn" - :uri-mapping {"http://localhost:2021" - "https://home.juxt.site"}})) + {:pred (fn [x] (or (= (:juxt.home/type x) "Person"))) + :filename "/home/mal/Sync/persons.edn" + :uri-mapping {"http://localhost:2021" + "https://home.juxt.site"}})) (defn export-resources "Export all resources to a file." @@ -273,12 +273,12 @@ (let [line (pr-str ent)] ;; Test the line can be read #_(try - (validate-resource-line line) - (catch Exception e - (throw - (ex-info - (format "Serialization of entity '%s' will not be readable" (:xt/id ent)) - {:xt/id (:xt/id ent)} e)))) + (validate-resource-line line) + (catch Exception e + (throw + (ex-info + (format "Serialization of entity '%s' will not be readable" (:xt/id ent)) + {:xt/id (:xt/id ent)} e)))) (.write w line) (.write w (System/lineSeparator)))) (let [n (inc (first (last batch))) @@ -301,9 +301,9 @@ (defn rules [] (sort-by - str - (map first - (q '{:find [(pull e [*])] :where [[e ::site/type "Rule"]]})))) + str + (map first + (q '{:find [(pull e [*])] :where [[e ::site/type "Rule"]]})))) (defn uuid ([] (str (java.util.UUID/randomUUID))) @@ -314,10 +314,10 @@ (defn req [s] (into - (sorted-map) - (cache/find - cache/requests-cache - (re-pattern (str "/_site/requests/" s))))) + (sorted-map) + (cache/find + cache/requests-cache + (re-pattern (str "/_site/requests/" s))))) (defn recent ([] (recent 5)) @@ -356,12 +356,12 @@ ([{::site/keys [base-uri]}] (map first (xt/q (db) '{:find [user] - :where [[user ::site/type "User"] - [mapping ::site/type "UserRoleMapping"] - [mapping ::pass/assignee user] - [mapping ::pass/role superuser]] - :in [superuser]} - (str base-uri "/_site/roles/superuser"))))) + :where [[user ::site/type "User"] + [mapping ::site/type "UserRoleMapping"] + [mapping ::pass/assignee user] + [mapping ::pass/role superuser]] + :in [superuser]} + (str base-uri "/_site/roles/superuser"))))) (defn steps ([] (steps (config))) @@ -371,11 +371,11 @@ db (xt/db (xt-node))] [;; Awaiting a fix to https://github.com/juxt/xtdb/issues/1480 #_{:complete? (and - (xt/entity db (str base-uri "/_site/tx_fns/put_if_match_wildcard")) - (xt/entity db (str base-uri "/_site/tx_fns/put_if_match_etags"))) - :happy-message "Site transaction functions installed." - :sad-message "Site transaction functions not installed. " - :fix "Enter (put-site-txfns!) to fix this."} + (xt/entity db (str base-uri "/_site/tx_fns/put_if_match_wildcard")) + (xt/entity db (str base-uri "/_site/tx_fns/put_if_match_etags"))) + :happy-message "Site transaction functions installed." + :sad-message "Site transaction functions not installed. " + :fix "Enter (put-site-txfns!) to fix this."} {:complete? (xt/entity db (str base-uri "/_site/apis/site/openapi.json")) :happy-message "Site API resources installed." @@ -405,9 +405,9 @@ (if complete? (println "[✔] " (ansi/green happy-message)) (println - "[ ] " - (ansi/red sad-message) - (ansi/yellow fix)))) + "[ ] " + (ansi/red sad-message) + (ansi/yellow fix)))) (println) (if (every? :complete? steps) :ok :incomplete))) @@ -447,11 +447,11 @@ (let [config (config) xt-node (xt-node)] (init/put-superuser! - xt-node - {:username username - :fullname fullname - :password password} - config) + xt-node + {:username username + :fullname fullname + :password password} + config) (status (steps config))))) (defn update-site-graphql @@ -484,12 +484,12 @@ (defn reset-password! [username password] (let [user (str (::site/base-uri (config)) "/_site/users/" username)] (put! - {:xt/id (str user "/password") - ::site/type "Password" - ::http/methods #{:post} - ::pass/user user - ::pass/password-hash (password/encrypt password) - ::pass/classification "RESTRICTED"}))) + {:xt/id (str user "/password") + ::site/type "Password" + ::http/methods #{:post} + ::pass/user user + ::pass/password-hash (password/encrypt password) + ::pass/classification "RESTRICTED"}))) (defn user [username] (e (format "%s/_site/users/%s" (::site/base-uri (config)) username))) diff --git a/src/juxt/site/alpha/rules.clj b/src/juxt/site/alpha/rules.clj index 71769fe39..960e2e900 100644 --- a/src/juxt/site/alpha/rules.clj +++ b/src/juxt/site/alpha/rules.clj @@ -18,8 +18,8 @@ (str uri (hash (select-keys request-instance [::pass/target ::pass/effect])))] (->> (x/submit-tx - xt-node - [[:xtdb.api/put (merge {:xt/id location} request-instance)]]) + xt-node + [[:xtdb.api/put (merge {:xt/id location} request-instance)]]) (x/await-tx xt-node)) (-> req @@ -28,9 +28,9 @@ (defn match-targets [db rules request-context] (let [temp-id-map (reduce-kv - ;; Preserve any existing xt/id - e.g. the resource will have one - (fn [acc k v] (assoc acc k (merge {:xt/id (java.util.UUID/randomUUID)} v))) - {} request-context) + ;; Preserve any existing xt/id - e.g. the resource will have one + (fn [acc k v] (assoc acc k (merge {:xt/id (java.util.UUID/randomUUID)} v))) + {} request-context) ;; Speculatively put each entry of the request context into the ;; database. This new database is only in scope for this authorization. db (x/with-tx db (->> temp-id-map @@ -63,20 +63,20 @@ (defn eval-triggers [db triggers request-context] (let [temp-id-map (reduce-kv - ;; Preserve any existing xt/id - e.g. the resource will have one - (fn [acc k v] (assoc acc k (merge {:xt/id (java.util.UUID/randomUUID)} v))) - {} request-context) + ;; Preserve any existing xt/id - e.g. the resource will have one + (fn [acc k v] (assoc acc k (merge {:xt/id (java.util.UUID/randomUUID)} v))) + {} request-context) ;; Speculatively put each entry of the request context into the ;; database. This new database is only in scope for this authorization. db (x/with-tx db (mapv (fn [e] [:xtdb.api/put e]) (vals temp-id-map)))] (keep - (fn [trigger-id] - (let [trigger (x/entity db trigger-id) - q (merge (::site/query trigger) - {:in (vec (keys temp-id-map))}) - action-data (apply x/q db q (map :xt/id (vals temp-id-map)))] - (when (seq action-data) - {:trigger trigger - :action-data action-data}))) - triggers))) + (fn [trigger-id] + (let [trigger (x/entity db trigger-id) + q (merge (::site/query trigger) + {:in (vec (keys temp-id-map))}) + action-data (apply x/q db q (map :xt/id (vals temp-id-map)))] + (when (seq action-data) + {:trigger trigger + :action-data action-data}))) + triggers))) diff --git a/test/juxt/site/graphql_test.clj b/test/juxt/site/graphql_test.clj index b15c88006..b9fd8b3cc 100644 --- a/test/juxt/site/graphql_test.clj +++ b/test/juxt/site/graphql_test.clj @@ -31,21 +31,21 @@ (defn graphql [] (init/put-site-api! *xt-node* {::site/base-uri "https://example.org"}) (submit-and-await! - [[:xtdb.api/put access-all-areas] + [[:xtdb.api/put access-all-areas] - [:xtdb.api/put - {:xt/id "https://example.org/_site/users/mal" - :juxt.site.alpha/type "User" - :juxt.pass.alpha/username "mal" - :email "mal@juxt.pro" - :name "Malcolm Sparks"}] + [:xtdb.api/put + {:xt/id "https://example.org/_site/users/mal" + :juxt.site.alpha/type "User" + :juxt.pass.alpha/username "mal" + :email "mal@juxt.pro" + :name "Malcolm Sparks"}] - [:xtdb.api/put - {:xt/id "https://example.org/_site/users/alx" - :juxt.site.alpha/type "User" - :juxt.pass.alpha/username "alx" - :email "alx@juxt.pro" - :name "Alex Davis"}]]) + [:xtdb.api/put + {:xt/id "https://example.org/_site/users/alx" + :juxt.site.alpha/type "User" + :juxt.pass.alpha/username "alx" + :email "alx@juxt.pro" + :name "Alex Davis"}]]) ;; GraphQL query (direct, for EDN) (let [query "{ allUsers { id } }" @@ -54,11 +54,11 @@ bytes (.getBytes json) r (*handler* - {:ring.request/method :post - :ring.request/path "/_site/graphql" - :ring.request/headers {"content-length" (str (count bytes)) - "content-type" "application/json"} - :ring.request/body (ByteArrayInputStream. bytes)})] + {:ring.request/method :post + :ring.request/path "/_site/graphql" + :ring.request/headers {"content-length" (str (count bytes)) + "content-type" "application/json"} + :ring.request/body (ByteArrayInputStream. bytes)})] (is (= 200 (:ring.response/status r))) (is (= {"data" @@ -70,67 +70,67 @@ (graphql)) #_((t/join-fixtures [with-xt with-handler]) - (fn [] - (submit-and-await! - [[:xtdb.api/put - {:xt/id "https://example.org/_site/users/mal", - :juxt.site.alpha/type "User", - :juxt.pass.alpha/username "mal", - :email "mal@juxt.pro", - :name "Malcolm Sparks"}] - - [:xtdb.api/put - {:xt/id "https://example.org/_site/users/alx", - :juxt.site.alpha/type "User", - :juxt.pass.alpha/username "alx", - :email "alx@juxt.pro", - :name "Alex Davis"}] - - [:xtdb.api/put - {:xt/id "https://example.org/_site/users/joa", - :juxt.site.alpha/type "User", - :juxt.pass.alpha/username "joa", - :email "joa@juxt.pro", - :name "Johanna Antonelli"}] - - [:xtdb.api/put - {:xt/id "https://example.org/_site/roles/superuser", - :juxt.site.alpha/type "Role", - :name "superuser", - :description "Superuser"}] - - [:xtdb.api/put - {:xt/id "https://example.org/_site/roles/developer", - :juxt.site.alpha/type "Role", - :name "developer", - :description "Developer"}] - - [:xtdb.api/put - {:xt/id "https://example.org/_site/roles/superuser/users/mal", - ::site/type "UserRoleMapping", - ::pass/assignee "https://example.org/_site/users/mal", - ::pass/role "https://example.org/_site/roles/superuser"}] - - [:xtdb.api/put - {:xt/id "https://example.org/_site/roles/developer/users/mal", - ::site/type "UserRoleMapping", - ::pass/assignee "https://example.org/_site/users/mal", - ::pass/role "https://example.org/_site/roles/developer"}] - - [:xtdb.api/put - {:xt/id "https://example.org/_site/roles/superuser/users/joa", - ::site/type "UserRoleMapping", - ::pass/assignee "https://example.org/_site/users/joa", - ::pass/role "https://example.org/_site/roles/developer"}] - - ]) - - (let [schema-str (slurp (io/resource "juxt/site/alpha/site-schema.graphql")) - schema (schema/compile-schema (parser/parse schema-str)) - query "{ allUsers { id name email roles { name } } }" - document (document/compile-document (parser/parse query) schema)] - - (graphql/query schema document nil {} {::site/db (x/db *xt-node*)})))) + (fn [] + (submit-and-await! + [[:xtdb.api/put + {:xt/id "https://example.org/_site/users/mal", + :juxt.site.alpha/type "User", + :juxt.pass.alpha/username "mal", + :email "mal@juxt.pro", + :name "Malcolm Sparks"}] + + [:xtdb.api/put + {:xt/id "https://example.org/_site/users/alx", + :juxt.site.alpha/type "User", + :juxt.pass.alpha/username "alx", + :email "alx@juxt.pro", + :name "Alex Davis"}] + + [:xtdb.api/put + {:xt/id "https://example.org/_site/users/joa", + :juxt.site.alpha/type "User", + :juxt.pass.alpha/username "joa", + :email "joa@juxt.pro", + :name "Johanna Antonelli"}] + + [:xtdb.api/put + {:xt/id "https://example.org/_site/roles/superuser", + :juxt.site.alpha/type "Role", + :name "superuser", + :description "Superuser"}] + + [:xtdb.api/put + {:xt/id "https://example.org/_site/roles/developer", + :juxt.site.alpha/type "Role", + :name "developer", + :description "Developer"}] + + [:xtdb.api/put + {:xt/id "https://example.org/_site/roles/superuser/users/mal", + ::site/type "UserRoleMapping", + ::pass/assignee "https://example.org/_site/users/mal", + ::pass/role "https://example.org/_site/roles/superuser"}] + + [:xtdb.api/put + {:xt/id "https://example.org/_site/roles/developer/users/mal", + ::site/type "UserRoleMapping", + ::pass/assignee "https://example.org/_site/users/mal", + ::pass/role "https://example.org/_site/roles/developer"}] + + [:xtdb.api/put + {:xt/id "https://example.org/_site/roles/superuser/users/joa", + ::site/type "UserRoleMapping", + ::pass/assignee "https://example.org/_site/users/joa", + ::pass/role "https://example.org/_site/roles/developer"}] + + ]) + + (let [schema-str (slurp (io/resource "juxt/site/alpha/site-schema.graphql")) + schema (schema/compile-schema (parser/parse schema-str)) + query "{ allUsers { id name email roles { name } } }" + document (document/compile-document (parser/parse query) schema)] + + (graphql/query schema document nil {} {::site/db (x/db *xt-node*)})))) (defn add-body [m s ct] @@ -144,54 +144,54 @@ (let [query "query { persons { name }}"] (submit-and-await! - [[:xtdb.api/put access-all-areas] - - [:xtdb.api/put - {:xt/id "https://example.org/alice" - :type "Person" - :name "Alice"}] - - [:xtdb.api/put - {:xt/id "https://example.org/bob" - :type "Person" - :name "Bob"}] - - [:xtdb.api/put - {:xt/id "https://example.org/graphql" - :doc "A GraphQL endpoint" - :juxt.http.alpha/methods #{:post :put :options} - :juxt.http.alpha/acceptable "application/graphql" - :juxt.site.alpha/put-fn 'juxt.site.alpha.graphql/put-handler - :juxt.site.alpha/post-fn 'juxt.site.alpha.graphql/post-handler}] - - [:xtdb.api/put - {:xt/id "https://example.org/get-persons" - :doc "A GraphQL stored query" - :juxt.http.alpha/methods #{:put :post} - :juxt.http.alpha/acceptable #{"application/graphql" "application/json"} - :juxt.site.alpha/graphql-schema "https://example.org/graphql" - :juxt.site.alpha/put-fn 'juxt.site.alpha.graphql/stored-document-put-handler - :juxt.site.alpha/post-fn 'juxt.site.alpha.graphql/stored-document-post-handler}] - - ;; Install variants to have CSV output - ]) + [[:xtdb.api/put access-all-areas] + + [:xtdb.api/put + {:xt/id "https://example.org/alice" + :type "Person" + :name "Alice"}] + + [:xtdb.api/put + {:xt/id "https://example.org/bob" + :type "Person" + :name "Bob"}] + + [:xtdb.api/put + {:xt/id "https://example.org/graphql" + :doc "A GraphQL endpoint" + :juxt.http.alpha/methods #{:post :put :options} + :juxt.http.alpha/acceptable "application/graphql" + :juxt.site.alpha/put-fn 'juxt.site.alpha.graphql/put-handler + :juxt.site.alpha/post-fn 'juxt.site.alpha.graphql/post-handler}] + + [:xtdb.api/put + {:xt/id "https://example.org/get-persons" + :doc "A GraphQL stored query" + :juxt.http.alpha/methods #{:put :post} + :juxt.http.alpha/acceptable #{"application/graphql" "application/json"} + :juxt.site.alpha/graphql-schema "https://example.org/graphql" + :juxt.site.alpha/put-fn 'juxt.site.alpha.graphql/stored-document-put-handler + :juxt.site.alpha/post-fn 'juxt.site.alpha.graphql/stored-document-post-handler}] + + ;; Install variants to have CSV output + ]) ;; Install a GraphQL schema at /graphql (let [schema " type Query { persons: [Person] @site(q: { find: [e] where: [[e {keyword: \"type\"} \"Person\"]]})} type Person { name: String @site(a: \"name\")}" response (*handler* - (-> {:ring.request/method :put - :ring.request/path "/graphql"} - (add-body schema "application/graphql")))] + (-> {:ring.request/method :put + :ring.request/path "/graphql"} + (add-body schema "application/graphql")))] (is (= 204 (:ring.response/status response)))) ;; POST a query to that schema (let [response (*handler* - (-> {:ring.request/method :post - :ring.request/path "/graphql"} - (add-body query "application/graphql"))) + (-> {:ring.request/method :post + :ring.request/path "/graphql"} + (add-body query "application/graphql"))) body (json/read-value (:ring.response/body response))] (is (= 200 (:ring.response/status response))) @@ -199,19 +199,19 @@ type Person { name: String @site(a: \"name\")}" ;; PUT a stored query (*handler* - (-> {:ring.request/method :put - :ring.request/path "/get-persons"} - (add-body query "application/graphql"))) + (-> {:ring.request/method :put + :ring.request/path "/get-persons"} + (add-body query "application/graphql"))) ;; POST to a stored query #_(*handler* - (-> {:ring.request/method :post - :ring.request/path "/get-persons"} - (add-body (json/write-value-as-string {}) "application/json"))))) + (-> {:ring.request/method :post + :ring.request/path "/get-persons"} + (add-body (json/write-value-as-string {}) "application/json"))))) #_((t/join-fixtures [with-xt with-handler]) - stored-query - ) + stored-query + ) (deftest stored-query-test (stored-query)) @@ -225,18 +225,162 @@ type Person { name: String @site(a: \"name\")}" (comment (schema/compile-schema (parser/parse "extend schema @site(import: \"/graphql\") type Query { person: Person } type Person { name: String }"))) - -(defn mutation [] - (let [schema " +(def straight-mutation-schema + " schema { query: Query mutation: Mutation } type Query { person: Person } type Person { id: ID @site(a: \"xt/id\") name: String } -scalar Date type Mutation { addPerson(id: ID @site(a: \"xt/id\") name: String): Person } -" - query "mutation { addPerson(id: \"https://example.org/persons/mal\" name: \"Malcolm Sparks\") { id name }}"] +") + +(def straight-query + " +mutation { + addPerson( + id: \"https://example.org/persons/mal\" + name: \"Malcolm Sparks\" + ) { id name } +} +") + +(def query-with-input + " +mutation { + addPerson(person: { + id: \"https://example.org/persons/mal\" + name: \"Malcolm Sparks\"}) + { id name } +} +") + +(def valid-mutation-schema + " +schema { query: Query mutation: Mutation } +type Query { person: Person } +type Person { id: ID @site(a: \"xt/id\") name: String } +input PersonInput { name: String! id: ID } + +type Mutation { + addPerson( + person: PersonInput + ): Person @site( + validation: { + person: \"[:map [:id {:optional true} :any] [:name [:string {:min 1 :max 20}]]]\" + } + ) +} +") + +(def invalid-mutation-schema + " +schema { query: Query mutation: Mutation } +type Query { person: Person } + type Person { id: ID @site(a: \"xt/id\") name: String } +input PersonInput { name: String! id: ID } + +type Mutation { + addPerson( + person: PersonInput + ): Person @site( + validation: { + person: \"[:map [:id {:optional true} :any] [:name [:string {:min 1 :max 5}]]]\" + } + ) +} +") + +(defn put-schema [schema] + (*handler* + (-> {:ring.request/method :put + :ring.request/path "/graphql"} + (add-body schema "application/graphql")))) + +(defn post-mutation [query] + (*handler* + (-> {:ring.request/method :post + :ring.request/path "/graphql"} + (add-body query "application/graphql")))) + +(defn mutation-base [schema query expected-response] + (submit-and-await! + [[:xtdb.api/put access-all-areas] + + [:xtdb.api/put + {:xt/id "https://example.org/graphql" + :doc "A GraphQL endpoint" + :juxt.http.alpha/methods #{:post :put :options} + :juxt.http.alpha/acceptable "application/graphql" + :juxt.site.alpha/put-fn 'juxt.site.alpha.graphql/put-handler + :juxt.site.alpha/post-fn 'juxt.site.alpha.graphql/post-handler}]]) + + ;; Install a GraphQL schema at /graphql + (is (= 204 (:ring.response/status (put-schema schema)))) + + ;; POST a mutation to that endpoint + (let [response (post-mutation query)] + + (when (= (get-in response [:ring.response/status]) 500) + (throw (ex-info "Unexpected error" {:response response}))) + + (is (= 200 (:ring.response/status response))) + + response + + (when-not (= (get-in response [:ring.response/headers "content-type"]) + "application/json") + (throw (ex-info "Unexpected content-type" + {:content-type (get-in response [:ring.response/headers "content-type"])}))) + + ;; Ensure mutation worked + (let [db (xt/db *xt-node*)] + (is (= {:xt/id "https://example.org/persons/mal" + :juxt.site/type "Person" + :name "Malcolm Sparks"} + (-> (xt/entity db "https://example.org/persons/mal") + (dissoc :_siteCreatedAt))))) + + (let [body (json/read-value (:ring.response/body response))] + (is (= expected-response body))))) + +#_((t/join-fixtures [with-xt with-handler]) + mutation + ) + +(deftest mutation-test + (mutation-base + + ;; schema + straight-mutation-schema + + ;; query + straight-query + + ;; expected-response + {"data" + {"addPerson" + {"id" "https://example.org/persons/mal" + "name" "Malcolm Sparks"}}})) + +(deftest mutation-with-validation-directive-test + (mutation-base + + ;; schema + valid-mutation-schema + + ;; query + query-with-input + + ;; expected-response + {"data" + {"addPerson" + {"id" "https://example.org/persons/mal" + "name" "Malcolm Sparks"}}})) + +(defn invalid-mutation-with-validation-directive [] + (let [schema invalid-mutation-schema + query query-with-input] (submit-and-await! [[:xtdb.api/put access-all-areas] @@ -292,19 +436,15 @@ type Mutation { ;;body )))) -#_((t/join-fixtures [with-xt with-handler]) - mutation - ) - -(deftest mutation-test - (mutation)) +(deftest invalid-mutation-with-validation-directive-test + (invalid-mutation-with-validation-directive)) #_(parser/parse "mutation { addPerson { name }}") #_(schema/compile-schema - (parser/parse - " + (parser/parse + " schema { query: Query mutation: Mutation } type Query { person: Person } enum WorkerStatus { EMPLOYEE CONTIGENT } @@ -320,4 +460,4 @@ type Mutation { addHoliday(person: ID beginning: Date! ending: Date! description: String): Holiday } " - )) + )) From 65c5ee9b3031646709b56861f03b8e1c27b10266 Mon Sep 17 00:00:00 2001 From: modality Date: Tue, 5 Jul 2022 15:40:54 +0100 Subject: [PATCH 27/33] fix test after merge --- test/juxt/site/graphql_test.clj | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/test/juxt/site/graphql_test.clj b/test/juxt/site/graphql_test.clj index b9fd8b3cc..f93fb38b2 100644 --- a/test/juxt/site/graphql_test.clj +++ b/test/juxt/site/graphql_test.clj @@ -421,20 +421,18 @@ type Mutation { ;; Ensure mutation worked (let [db (xt/db *xt-node*)] - (is (= {:xt/id "https://example.org/persons/mal" - :juxt.site/type "Person" - :name "Malcolm Sparks"} - (-> (xt/entity db "https://example.org/persons/mal") - (select-keys [:xt/id :juxt.site/type :name]))))) - - (let [body (json/read-value (:ring.response/body response))] - (is (= {"data" - {"addPerson" - {"id" "https://example.org/persons/mal" - "name" "Malcolm Sparks"}}} - body)) - ;;body - )))) + (is (= nil + (xt/entity db "https://example.org/persons/mal")))) + + (let [error-message (-> response + :ring.response/body + json/read-value + (get "errors") + first + (get "message"))] + + (is (= error-message + "({:name [\"should be between 1 and 5 characters\"]})")))))) (deftest invalid-mutation-with-validation-directive-test (invalid-mutation-with-validation-directive)) From a1f84e4768050a515aea94cc1f2cc3159d265c4f Mon Sep 17 00:00:00 2001 From: modality Date: Tue, 5 Jul 2022 17:11:27 +0100 Subject: [PATCH 28/33] set KG_URL_BASE from env --- src/juxt/site/alpha/repl.clj | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index e1b9e97ab..0dc99bac5 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -184,6 +184,12 @@ (let [tx-id (xt/submit-tx node tx)] (xt/await-tx node tx-id))) + +(let [kg-url-base (or (System/getenv "KG_URL_BASE") "http://localhost:5509")] + (defn- set-kg-url-base + [^String rec] + (clojure.string/replace rec #"\{\{KG_URL_BASE\}\}" kg-url-base))) + (defn import-resources ([] (import-resources "import/resources.edn")) ([filename] @@ -194,7 +200,7 @@ (if (xt/entity (xt/db node) (:xt/id rec)) (println "Skipping existing resource: " (:xt/id rec)) (do - (submit-and-wait-tx node [[:xtdb.api/put rec]]) + (submit-and-wait-tx node [[:xtdb.api/put (set-kg-url-base rec)]]) (println "Imported resource: " (:xt/id rec))))))))) (defn validate-resource-line [s] From 4aab310d21c2d82cea4b8c43b4d1543e1e7839c6 Mon Sep 17 00:00:00 2001 From: modality Date: Tue, 5 Jul 2022 17:47:37 +0100 Subject: [PATCH 29/33] read back edn after string/replace --- src/juxt/site/alpha/repl.clj | 178 +++++++++++++++++------------------ 1 file changed, 88 insertions(+), 90 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 0dc99bac5..32bc55252 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -62,16 +62,16 @@ (defn e [id] (postwalk - (fn [x] (if (and (vector? x) - (#{::http/content ::http/body} (first x)) - (> (count (second x)) 1024)) + (fn [x] (if (and (vector? x) + (#{::http/content ::http/body} (first x)) + (> (count (second x)) 1024)) - [(first x) - (cond - (= ::http/content (first x)) (str (subs (second x) 0 80) "…") - :else (format "(%d bytes)" (count (second x))))] - x)) - (xt/entity (db) id))) + [(first x) + (cond + (= ::http/content (first x)) (str (subs (second x) 0 80) "…") + :else (format "(%d bytes)" (count (second x))))] + x)) + (xt/entity (db) id))) (defn hist [id] (xt/entity-history (db) id :asc {:with-docs? true})) @@ -80,44 +80,44 @@ (defn put! [& ms] (->> - (xt/submit-tx - (xt-node) - (for [m ms] - (let [vt (:xtdb.api/valid-time m)] - [:xtdb.api/put (dissoc m :xtdb.api/valid-time) vt]))) - (xt/await-tx (xt-node)))) + (xt/submit-tx + (xt-node) + (for [m ms] + (let [vt (:xtdb.api/valid-time m)] + [:xtdb.api/put (dissoc m :xtdb.api/valid-time) vt]))) + (xt/await-tx (xt-node)))) (defn grep [re coll] (filter #(re-matches (re-pattern re) %) coll)) (defn rm! [& ids] (->> - (xt/submit-tx - (xt-node) - (for [id ids] - [:xtdb.api/delete id])) - (xt/await-tx (xt-node)))) + (xt/submit-tx + (xt-node) + (for [id ids] + [:xtdb.api/delete id])) + (xt/await-tx (xt-node)))) (defn evict! [& ids] (->> - (xt/submit-tx - (xt-node) - (for [id ids] - [:xtdb.api/evict id])) - (xt/await-tx (xt-node)))) + (xt/submit-tx + (xt-node) + (for [id ids] + [:xtdb.api/evict id])) + (xt/await-tx (xt-node)))) (defn q [query & args] (apply xt/q (db) query args)) (defn t [t] (map - first - (xt/q (db) '{:find [e] :where [[e ::site/type t]] :in [t]} t))) + first + (xt/q (db) '{:find [e] :where [[e ::site/type t]] :in [t]} t))) (defn t* [t] (map - first - (xt/q (db) '{:find [e] :where [[e :type t]] :in [t]} t))) + first + (xt/q (db) '{:find [e] :where [[e :type t]] :in [t]} t))) (defn types [] (->> (q '{:find [t] @@ -156,18 +156,18 @@ (defn now-id [] (.format - (.withZone - (java.time.format.DateTimeFormatter/ofPattern "yyyy-MM-dd-HHmmss") - (java.time.ZoneId/systemDefault)) - (java.time.Instant/now))) + (.withZone + (java.time.format.DateTimeFormatter/ofPattern "yyyy-MM-dd-HHmmss") + (java.time.ZoneId/systemDefault)) + (java.time.Instant/now))) ;; Start import at 00:35 (defn resources-from-stream [in] (let [record (try (edn/read - {:eof :eof :readers edn-readers} - in) + {:eof :eof :readers edn-readers} + in) (catch Exception e (def in in) (prn (.getMessage e))))] @@ -184,11 +184,12 @@ (let [tx-id (xt/submit-tx node tx)] (xt/await-tx node tx-id))) - (let [kg-url-base (or (System/getenv "KG_URL_BASE") "http://localhost:5509")] (defn- set-kg-url-base - [^String rec] - (clojure.string/replace rec #"\{\{KG_URL_BASE\}\}" kg-url-base))) + [rec] + (-> rec + (clojure.string/replace #"\{\{KG_URL_BASE\}\}" kg-url-base) + (edn/read-string)))) (defn import-resources ([] (import-resources "import/resources.edn")) @@ -205,15 +206,15 @@ (defn validate-resource-line [s] (edn/read-string - {:eof :eof :readers edn-readers} - s)) + {:eof :eof :readers edn-readers} + s)) (defn get-zipped-output-stream [] (let [zos (doto - (-> (str (now-id) ".edn.zip") - io/file - io/output-stream - java.util.zip.ZipOutputStream.) + (-> (str (now-id) ".edn.zip") + io/file + io/output-stream + java.util.zip.ZipOutputStream.) (.putNextEntry (java.util.zip.ZipEntry. "resources.edn")))] (java.io.OutputStreamWriter. zos))) @@ -222,18 +223,18 @@ ;; Create a regex pattern which detects anything as a mapping key (let [pat (re-pattern (str/join "|" (map #(format "\\Q%s\\E" %) (keys mapping))))] (postwalk - (fn [s] - (cond-> s - (string? s) - (str/replace pat (fn [x] (get mapping x))))) - ent)))) + (fn [s] + (cond-> s + (string? s) + (str/replace pat (fn [x] (get mapping x))))) + ent)))) (comment (export-resources - {:pred (fn [x] (or (= (:juxt.home/type x) "Person"))) - :filename "/home/mal/Sync/persons.edn" - :uri-mapping {"http://localhost:2021" - "https://home.juxt.site"}})) + {:pred (fn [x] (or (= (:juxt.home/type x) "Person"))) + :filename "/home/mal/Sync/persons.edn" + :uri-mapping {"http://localhost:2021" + "https://home.juxt.site"}})) (defn export-resources "Export all resources to a file." @@ -267,9 +268,9 @@ (validate-resource-line line) (catch Exception e (throw - (ex-info - (format "Serialization of entity '%s' will not be readable" (:xt/id ent)) - {:xt/id (:xt/id ent)} e)))) + (ex-info + (format "Serialization of entity '%s' will not be readable" (:xt/id ent)) + {:xt/id (:xt/id ent)} e)))) (.write w line) (.write w (System/lineSeparator)))) (let [n (inc (first (last batch))) @@ -280,7 +281,6 @@ (remove-method print-method (type (byte-array []))) (printf "Dumped %d resources\n" (count resources))))) - (defn cat-type [t] (->> (q '{:find [(pull e [*])] @@ -292,9 +292,9 @@ (defn rules [] (sort-by - str - (map first - (q '{:find [(pull e [*])] :where [[e ::site/type "Rule"]]})))) + str + (map first + (q '{:find [(pull e [*])] :where [[e ::site/type "Rule"]]})))) (defn uuid ([] (str (java.util.UUID/randomUUID))) @@ -305,17 +305,16 @@ (defn req [s] (into - (sorted-map) - (cache/find - cache/requests-cache - (re-pattern (str "/_site/requests/" s))))) + (sorted-map) + (cache/find + cache/requests-cache + (re-pattern (str "/_site/requests/" s))))) (defn recent ([] (recent 5)) ([n] (map (juxt ::site/request-id ::site/date ::site/uri :ring.request/method :ring.response/status) - (cache/recent cache/requests-cache n)) - )) + (cache/recent cache/requests-cache n)))) (defn requests-cache [] cache/requests-cache) @@ -362,8 +361,8 @@ db (xt/db (xt-node))] [;; Awaiting a fix to https://github.com/juxt/xtdb/issues/1480 #_{:complete? (and - (xt/entity db (str base-uri "/_site/tx_fns/put_if_match_wildcard")) - (xt/entity db (str base-uri "/_site/tx_fns/put_if_match_etags"))) + (xt/entity db (str base-uri "/_site/tx_fns/put_if_match_wildcard")) + (xt/entity db (str base-uri "/_site/tx_fns/put_if_match_etags"))) :happy-message "Site transaction functions installed." :sad-message "Site transaction functions not installed. " :fix "Enter (put-site-txfns!) to fix this."} @@ -396,9 +395,9 @@ (if complete? (println "[✔] " (ansi/green happy-message)) (println - "[ ] " - (ansi/red sad-message) - (ansi/yellow fix)))) + "[ ] " + (ansi/red sad-message) + (ansi/yellow fix)))) (println) (if (every? :complete? steps) :ok :incomplete))) @@ -438,11 +437,11 @@ (let [config (config) xt-node (xt-node)] (init/put-superuser! - xt-node - {:username username - :fullname fullname - :password password} - config) + xt-node + {:username username + :fullname fullname + :password password} + config) (status (steps config))))) (defn update-site-graphql @@ -475,12 +474,12 @@ (defn reset-password! [username password] (let [user (str (::site/base-uri (config)) "/_site/users/" username)] (put! - {:xt/id (str user "/password") - ::site/type "Password" - ::http/methods #{:post} - ::pass/user user - ::pass/password-hash (password/encrypt password) - ::pass/classification "RESTRICTED"}))) + {:xt/id (str user "/password") + ::site/type "Password" + ::http/methods #{:post} + ::pass/user user + ::pass/password-hash (password/encrypt password) + ::pass/classification "RESTRICTED"}))) (defn user [username] (e (format "%s/_site/users/%s" (::site/base-uri (config)) username))) @@ -506,13 +505,12 @@ (defn repl-post-handler [{::site/keys [uri db] ::pass/keys [subject] :as req}] - (let [ - body (some-> req ::site/received-representation ::http/body (String.) read-string) + (let [body (some-> req ::site/received-representation ::http/body (String.) read-string) _ (when (nil? body) (throw - (ex-info - "Invalid body" - {::site/request-context req}))) + (ex-info + "Invalid body" + {::site/request-context req}))) results (try (binding [*ns* (find-ns 'juxt.site.alpha.repl)] @@ -522,7 +520,7 @@ (-> req (assoc - :ring.response/status 200 - :ring.response/body - (json/write-value-as-string results)) + :ring.response/status 200 + :ring.response/body + (json/write-value-as-string results)) (update :ring.response/headers assoc "content-type" "application/json")))) From 67f12855ed0e40453d408d6c25a437981a863c76 Mon Sep 17 00:00:00 2001 From: modality Date: Tue, 5 Jul 2022 18:11:20 +0100 Subject: [PATCH 30/33] forgot edn tags --- src/juxt/site/alpha/repl.clj | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 32bc55252..7f1d3e34b 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -187,9 +187,8 @@ (let [kg-url-base (or (System/getenv "KG_URL_BASE") "http://localhost:5509")] (defn- set-kg-url-base [rec] - (-> rec - (clojure.string/replace #"\{\{KG_URL_BASE\}\}" kg-url-base) - (edn/read-string)))) + (->> (clojure.string/replace rec #"\{\{KG_URL_BASE\}\}" kg-url-base) + (edn/read-string {:eof :eof :readers edn-readers})))) (defn import-resources ([] (import-resources "import/resources.edn")) @@ -198,11 +197,12 @@ in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] (doseq [rec (resources-from-stream in)] (when (:xt/id rec) - (if (xt/entity (xt/db node) (:xt/id rec)) - (println "Skipping existing resource: " (:xt/id rec)) - (do - (submit-and-wait-tx node [[:xtdb.api/put (set-kg-url-base rec)]]) - (println "Imported resource: " (:xt/id rec))))))))) + (let [rec (set-kg-url-base rec)] + (if (xt/entity (xt/db node) (:xt/id rec)) + (println "Skipping existing resource: " (:xt/id rec)) + (do + (submit-and-wait-tx node [[:xtdb.api/put rec]]) + (println "Imported resource: " (:xt/id rec)))))))))) (defn validate-resource-line [s] (edn/read-string From 3b15de35b8e31c91c07a7e0a4503095c1d9007d8 Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 6 Jul 2022 07:56:43 +0100 Subject: [PATCH 31/33] set-kg-uri-mapping --- src/juxt/site/alpha/repl.clj | 52 ++++++++++++++++++++---------------- 1 file changed, 29 insertions(+), 23 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index 7f1d3e34b..c95780600 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -190,19 +190,34 @@ (->> (clojure.string/replace rec #"\{\{KG_URL_BASE\}\}" kg-url-base) (edn/read-string {:eof :eof :readers edn-readers})))) -(defn import-resources - ([] (import-resources "import/resources.edn")) - ([filename] - (let [node (xt-node) - in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] - (doseq [rec (resources-from-stream in)] - (when (:xt/id rec) - (let [rec (set-kg-url-base rec)] - (if (xt/entity (xt/db node) (:xt/id rec)) - (println "Skipping existing resource: " (:xt/id rec)) - (do - (submit-and-wait-tx node [[:xtdb.api/put rec]]) - (println "Imported resource: " (:xt/id rec)))))))))) +(defn apply-uri-mappings + [mapping] + (fn [ent] + ;; Create a regex pattern which detects anything as a mapping key + (let [pat (re-pattern (str/join "|" (map #(format "\\Q%s\\E" %) (keys mapping))))] + (postwalk + (fn [s] + (cond-> s + (string? s) + (str/replace pat (fn [x] (get mapping x))))) + ent)))) + +(let [url-mapping {"{{KG_URL_BASE}}" + (or (System/getenv "KG_URL_BASE") "http://localhost:5509")} + set-kg-url-base (apply-uri-mappings url-mapping)] + (defn import-resources + ([] (import-resources "import/resources.edn")) + ([filename] + (let [node (xt-node) + in (java.io.PushbackReader. (io/reader (io/input-stream (io/file filename))))] + (doseq [rec (resources-from-stream in)] + (when (:xt/id rec) + (let [rec (set-kg-url-base rec)] + (if (xt/entity (xt/db node) (:xt/id rec)) + (println "Skipping existing resource: " (:xt/id rec)) + (do + (submit-and-wait-tx node [[:xtdb.api/put rec]]) + (println "Imported resource: " (:xt/id rec))))))))))) (defn validate-resource-line [s] (edn/read-string @@ -218,16 +233,7 @@ (.putNextEntry (java.util.zip.ZipEntry. "resources.edn")))] (java.io.OutputStreamWriter. zos))) -(defn apply-uri-mappings [mapping] - (fn [ent] - ;; Create a regex pattern which detects anything as a mapping key - (let [pat (re-pattern (str/join "|" (map #(format "\\Q%s\\E" %) (keys mapping))))] - (postwalk - (fn [s] - (cond-> s - (string? s) - (str/replace pat (fn [x] (get mapping x))))) - ent)))) + (comment (export-resources From 56cbdc2873208d511f8702c477602cd10c24b41b Mon Sep 17 00:00:00 2001 From: modality Date: Wed, 6 Jul 2022 08:00:14 +0100 Subject: [PATCH 32/33] removed unused --- src/juxt/site/alpha/repl.clj | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/juxt/site/alpha/repl.clj b/src/juxt/site/alpha/repl.clj index c95780600..8bd9b22c8 100644 --- a/src/juxt/site/alpha/repl.clj +++ b/src/juxt/site/alpha/repl.clj @@ -184,12 +184,6 @@ (let [tx-id (xt/submit-tx node tx)] (xt/await-tx node tx-id))) -(let [kg-url-base (or (System/getenv "KG_URL_BASE") "http://localhost:5509")] - (defn- set-kg-url-base - [rec] - (->> (clojure.string/replace rec #"\{\{KG_URL_BASE\}\}" kg-url-base) - (edn/read-string {:eof :eof :readers edn-readers})))) - (defn apply-uri-mappings [mapping] (fn [ent] @@ -219,6 +213,9 @@ (submit-and-wait-tx node [[:xtdb.api/put rec]]) (println "Imported resource: " (:xt/id rec))))))))))) + + + (defn validate-resource-line [s] (edn/read-string {:eof :eof :readers edn-readers} From 9dc3ab77ce254720a9f7c4d01a16157fb30c6c60 Mon Sep 17 00:00:00 2001 From: Alex Davis Date: Wed, 6 Jul 2022 11:07:49 +0100 Subject: [PATCH 33/33] Add config file --- dev/config.edn | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 dev/config.edn diff --git a/dev/config.edn b/dev/config.edn new file mode 100644 index 000000000..db3c9b4f2 --- /dev/null +++ b/dev/config.edn @@ -0,0 +1,35 @@ +{ + ;; Used by bin/site to know where to send HTTP API requests. + :juxt.site.alpha/base-uri "http://localhost:5509" + + :ig/system + {:juxt.site.alpha.db/xt-node + { + :xtdb.http-server/server {:port 5511} + :xtdb.rocksdb/block-cache {:xtdb/module xtdb.rocksdb/->lru-block-cache + :cache-size 1600000000} + :xtdb/tx-log + {:kv-store {:xtdb/module xtdb.rocksdb/->kv-store + :db-dir "db/txes"}} + + :xtdb/document-store + {:kv-store {:xtdb/module xtdb.rocksdb/->kv-store + :db-dir "db/docs"}} + + :xtdb/index-store + {:kv-store {:xtdb/module xtdb.rocksdb/->kv-store + :db-dir "db/idxs"}}} + + :juxt.site.alpha.server/server + {:juxt.site.alpha/xt-node #ig/ref :juxt.site.alpha.db/xt-node + :juxt.site.alpha/port 5509 + + ;; Really, this is the canoncial-uri prefix where /_site exists. + :juxt.site.alpha/base-uri #ref [:juxt.site.alpha/base-uri] + + :juxt.site.alpha/dynamic? #profile {:dev true :prod false}} + + :juxt.site.alpha.nrepl/server + {:juxt.site.alpha/port 5510} +} +}