diff --git a/.gitignore b/.gitignore index 3d16971..90ce098 100644 --- a/.gitignore +++ b/.gitignore @@ -37,3 +37,5 @@ projects/**/pom.xml # Calva VS Code Extension .calva/output-window/output.calva-repl + +.portal diff --git a/bases/issue-261/deps.edn b/bases/issue-261/deps.edn new file mode 100644 index 0000000..dbe9a67 --- /dev/null +++ b/bases/issue-261/deps.edn @@ -0,0 +1,4 @@ +{:paths ["src" "resources"] + :deps {poly/sqldb {:local/root "../components/sqldb"}} + :aliases {:test {:extra-paths ["test"] + :extra-deps {}}}} diff --git a/bases/issue-261/resources/issue-261/.keep b/bases/issue-261/resources/issue-261/.keep new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/bases/issue-261/resources/issue-261/.keep @@ -0,0 +1 @@ + diff --git a/bases/issue-261/src/poly_rcf/rcf/issue_261/core.clj b/bases/issue-261/src/poly_rcf/rcf/issue_261/core.clj new file mode 100644 index 0000000..2d74d1d --- /dev/null +++ b/bases/issue-261/src/poly_rcf/rcf/issue_261/core.clj @@ -0,0 +1 @@ +(ns poly-rcf.rcf.issue-261.core) diff --git a/bases/issue-261/test/poly_rcf/rcf/issue_261/core_test.clj b/bases/issue-261/test/poly_rcf/rcf/issue_261/core_test.clj new file mode 100644 index 0000000..7d41225 --- /dev/null +++ b/bases/issue-261/test/poly_rcf/rcf/issue_261/core_test.clj @@ -0,0 +1,6 @@ +(ns poly-rcf.rcf.issue-261.core-test + (:require [clojure.test :as test :refer :all] + [poly-rcf.rcf.issue-261.core :as core])) + +(deftest dummy-test + (is (= 1 1))) diff --git a/bases/rcf/src/poly_rcf/rcf/config.clj b/bases/rcf/src/poly_rcf/rcf/config.clj new file mode 100644 index 0000000..e48d0cf --- /dev/null +++ b/bases/rcf/src/poly_rcf/rcf/config.clj @@ -0,0 +1,8 @@ +(ns poly-rcf.rcf.config) +;; A master configuration file. +;; Can be overriden with configuration files down in the classpath, +;; environment variables, and system properties + +{:dre {} + :sentry {:dsn "" + :environment ""}} diff --git a/components/sqldb/deps.edn b/components/sqldb/deps.edn new file mode 100644 index 0000000..d2ea931 --- /dev/null +++ b/components/sqldb/deps.edn @@ -0,0 +1,9 @@ +{:paths ["src" "resources"] + :deps {com.github.seancorfield/next.jdbc {:mvn/version "1.3.874"} + com.github.seancorfield/honeysql {:mvn/version "2.4.1026"} + com.zaxxer/HikariCP {:mvn/version "5.0.1" + :exclusions [org.slf4j/slf4j-api]} + org.clojure/tools.logging {:mvn/version "1.2.4"}} + :aliases {:test {:extra-paths ["test" "src"] ;; Adding src makes poly tool discover RCF tests under src/ + :extra-deps {com.h2database/h2 {:mvn/version "2.1.214"} + com.stuartsierra/component {:mvn/version "1.1.0"}}}}} diff --git a/components/sqldb/resources/sqldb/.keep b/components/sqldb/resources/sqldb/.keep new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/components/sqldb/resources/sqldb/.keep @@ -0,0 +1 @@ + diff --git a/components/sqldb/src/poly_rcf/rcf/sqldb/core.clj b/components/sqldb/src/poly_rcf/rcf/sqldb/core.clj new file mode 100644 index 0000000..23b5a19 --- /dev/null +++ b/components/sqldb/src/poly_rcf/rcf/sqldb/core.clj @@ -0,0 +1,211 @@ +;; Copyright (C) 2022, Doctor Evidence. All rights reserved. + +(ns poly-rcf.rcf.sqldb.core + "SQL DB client impl." + {:authors ["Jozef Wagner"]} + (:require [hugsql.adapter :as adapter] + [hugsql.adapter.next-jdbc :as next-jdbc-adapter] + [hugsql.core :as hugsql] + [next.jdbc :as jdbc] + [next.jdbc.connection :as connection] + [next.jdbc.result-set :as rs] + [next.jdbc.transaction :as transaction] + [clojure.tools.logging :refer [info warn trace]]) + (:import [com.zaxxer.hikari HikariDataSource])) + + +;;; HikariCP + +;;; HugSQL + +(defn get-connection + [sqlconn] + (or (:hikari-datasource sqlconn) sqlconn)) + +(defn strip-update-count + [result] + (if (and (seqable? result) + (= 1 (count result)) + (empty? (dissoc (first result) :next.jdbc/update-count)) + (integer? (:next.jdbc/update-count (first result)))) + [(:next.jdbc/update-count (first result))] + result)) + +(deftype HugsqlAdapterSqldb [child-adapter] + adapter/HugsqlAdapter + (execute [this sqlconn sqlvec options] + (adapter/execute child-adapter (get-connection sqlconn) sqlvec options)) + (query [this sqlconn sqlvec options] + (strip-update-count + (adapter/query child-adapter (get-connection sqlconn) sqlvec options))) + (result-one [this result options] + (first (strip-update-count [(adapter/result-one child-adapter result options)]))) + (result-many [this result options] + (strip-update-count (adapter/result-many child-adapter result options))) + (result-affected [this result options] + (adapter/result-affected child-adapter result options)) + (result-raw [this result options] + (strip-update-count (adapter/result-raw child-adapter result options))) + (on-exception [this exception] + (adapter/on-exception child-adapter exception))) + +(defn hugsql-adapter-sqldb + ([] + (hugsql-adapter-sqldb {})) + ([default-command-options] + (->HugsqlAdapterSqldb + (next-jdbc-adapter/hugsql-adapter-next-jdbc default-command-options)))) + +;;; SQLDB + +(deftype SqlReduce [sqlconn query params query-timeout fetch-size ptf] + clojure.lang.IReduce + (reduce [this f] + (.reduce ^clojure.lang.IReduceInit this f (f))) + clojure.lang.IReduceInit + (reduce [this f init] + (trace "DB: reducing sql query" query params) + #_(when-let [span (apm/current-apm-span)] + (apm/set-label span "sqldb-query" (str query)) + (apm/set-label span "sqldb-params" (str params))) + (binding [transaction/*nested-tx* :ignore] + (jdbc/with-transaction [tx (get-connection sqlconn) {}] + (let [ptf (or ptf #(rs/datafiable-row % tx {})) + opts {:fetch-size fetch-size + :timeout query-timeout + :result-type :forward-only + :concurrency :read-only + :builder-fn rs/as-unqualified-lower-maps} + sql-params (cons query params) + plan (jdbc/plan tx sql-params opts)] + (reduce f init (eduction (map ptf) plan))))))) + +(defn query + "Returns a reducible collection of query results. sql-params may be + a query string or a collection of query and params. + Supported opts are: + :sqldb/query-timeout - timeout in s; default as defined by driver + :sqldb/fetch-size - passed to jdbc; defaults to 1000 + :sqldb/ptf - row transformation function that'll be called + in parallel; defaults to sequential processing and + no additional transformation." + [conn sql-params opts] + (let [{:keys [:sqldb/query-timeout :sqldb/fetch-size :sqldb/ptf]} opts + fetch-size (or fetch-size 1000) + query (if (string? sql-params) sql-params (first sql-params)) + params (when-not (string? sql-params) (rest sql-params))] + (->SqlReduce conn query params query-timeout fetch-size ptf))) + +(defn query-eager + "Returns a reducible collection of query results. sql-params may be + a query string or a collection of query and params. + + Supported opts are: + :sqldb/query-timeout - timeout in s; default as defined by driver + :sqldb/fetch-size - passed to jdbc; defaults to 1000 + :sqldb/ptf - row transformation function that'll be called + in parallel; defaults to sequential processing and + no additional transformation." + [sqlconn sql-params opts] + (let [{:keys [:sqldb/query-timeout :sqldb/fetch-size :sqldb/ptf]} opts + fetch-size (or fetch-size 1000) + query (if (string? sql-params) sql-params (first sql-params)) + params (when-not (string? sql-params) (rest sql-params)) + sql-params (cons query params) + opts (merge opts + {:fetch-size fetch-size + :timeout query-timeout + :result-type :forward-only + :concurrency :read-only + :builder-fn rs/as-unqualified-lower-maps}) + conn (get-connection sqlconn) + ptf (or ptf #(rs/datafiable-row % conn {}))] + (eduction (map ptf) (jdbc/plan conn sql-params opts)))) + +(defn execute! + "Performs execute operation. + + Supported opts are: + :sqldb/query-timeout - timeout in s; default as defined by driver" + [sqlconn sql-params opts] + (let [{:keys [:sqldb/query-timeout]} opts + query (if (string? sql-params) sql-params (first sql-params)) + params (when-not (string? sql-params) (rest sql-params)) + opts (merge opts + {:timeout query-timeout + :builder-fn rs/as-unqualified-lower-maps}) + sql-params (into [query] params) + conn (get-connection sqlconn)] + (jdbc/execute! conn sql-params opts))) + + +;;; System Component + +(defn start-component + [new-sqldb] + (info "Create component with db" new-sqldb) + (let [db-spec (:db-spec new-sqldb) + hugsql-opts (:hugsql-opts new-sqldb) + hikari-datasource (connection/->pool HikariDataSource db-spec)] + (hugsql/set-adapter! (hugsql-adapter-sqldb hugsql-opts)) + (assoc new-sqldb + :hikari-datasource hikari-datasource))) + +(defn stop-component + [sqldb] + (when-let [^HikariDataSource ds (:hikari-datasource sqldb)] + (when-not (.isClosed ds) + (.close ds))) + (dissoc sqldb :hikari-datasource)) + +(defn suspend-component + [sqldb] + (info "Suspending SQLDB component") + sqldb) + +(defn resume-component + [_new-sqldb suspended-sqldb] + ;; TODO: Proper reconnect when cfg changes + (info "Resuming SQLDB component") + suspended-sqldb) + +(defn new-component + "Returns new sqldb system component." + [cfg tag] + (let [db-config (get-in cfg [:dre tag])] + (-> db-config + (with-meta {'com.stuartsierra.component/start start-component + 'com.stuartsierra.component/stop stop-component + 'suspendable.core/suspend suspend-component + 'suspendable.core/resume resume-component})))) + +(comment + + (set! *warn-on-reflection* true) + + (def SQLDB + (-> {:dre {:db {:maximum-pool-size 10 + :connection-timeout 30000 + :idle-timeout 600000 + :validation-timeout 5000 + :max-lifetime 1800000 + :jdbc "jdbc:postgresql://db:5432/docsearch?user=docsearch&password=docsearch"}}} + (new-component nil) + start-component)) + + (let [q "select * from articles_stats" + opts {:sqldb/ptf #(let [{:keys [:source :category :count]} %] + (warn "info" source category) + (nn-hash-map + :source source + :category category + :count count))}] + (try + (vec (eduction (take 2) (query SQLDB q opts))) + (catch org.postgresql.util.PSQLException e + (warn "Article stats materialized view was not refreshed" e) + {}))) + + (execute! SQLDB ["insert into file_activity(file_name, source) values (?, ?) returning id;" + "file123" "sourcetest"] + {})) diff --git a/components/sqldb/src/poly_rcf/rcf/sqldb/interface.clj b/components/sqldb/src/poly_rcf/rcf/sqldb/interface.clj new file mode 100644 index 0000000..1858e40 --- /dev/null +++ b/components/sqldb/src/poly_rcf/rcf/sqldb/interface.clj @@ -0,0 +1 @@ +(ns poly-rcf.rcf.sqldb.interface) diff --git a/components/sqldb/test/poly_rcf/rcf/sqldb/interface_test.clj b/components/sqldb/test/poly_rcf/rcf/sqldb/interface_test.clj new file mode 100644 index 0000000..487bbe7 --- /dev/null +++ b/components/sqldb/test/poly_rcf/rcf/sqldb/interface_test.clj @@ -0,0 +1,35 @@ +(ns poly-rcf.rcf.sqldb.interface-test + (:require [clojure.set :as set] + [clojure.test :as test :refer :all] + [clojure.tools.logging :as log] + [com.stuartsierra.component :as component] + [next.jdbc :as jdbc] + [next.jdbc.result-set :as rs] + [poly-rcf.rcf.sqldb.interface :as sqldb])) + +;; This fails because of https://github.com/polyfy/polylith/issues/261 +(deftest new-component-test + "Test component works by starting a system and running a query." + (let [config {:dre {:test {:db-spec {:maximum-pool-size 10 + :connection-timeout 30000 + :idle-timeout 600000 + :validation-timeout 5000 + :max-lifetime 1800000 + :jdbcUrl "jdbc:h2:mem:semmed"}}}} + sys (component/system-map + :sqldb (sqldb/new-component config :test)) + s (component/start-system sys) + sqldb (:sqldb s) + data-source (:hikari-datasource sqldb) + _ (log/info "datasource" sqldb) + ;; read table metadata + d (with-open [con (jdbc/get-connection data-source)] + (-> (.getMetaData con) ; produces java.sql.DatabaseMetaData + (.getTables nil nil nil (into-array ["TABLE" "VIEW"])) + (rs/datafiable-result-set con))) + some-tables #{"CONSTANTS" "ENUM_VALUES" "INDEXES" + "INDEX_COLUMNS" "INFORMATION_SCHEMA_CATALOG_NAME"} + all-tables (into #{} (map :TABLE_NAME d))] + ;; test that some tables are present in metadata + (is (true? (set/subset? some-tables all-tables))) + (component/stop-system s))) diff --git a/deps.edn b/deps.edn index d8627bf..271ef93 100644 --- a/deps.edn +++ b/deps.edn @@ -1,12 +1,15 @@ {:aliases {:dev {:extra-paths ["development/src"] - :extra-deps { - ;; bases + :extra-deps {;; bases poly/rcf {:local/root "bases/rcf"} - + poly/issue-261 {:local/root "bases/issue-261"} + ;; components + poly/sqldb {:local/root "components/sqldb"} + org.clojure/clojure {:mvn/version "1.11.1"}}} :test {:extra-paths ["bases/rcf/test" - "projects/rcf/test"]} + "projects/rcf/test" + "bases/issue-261/test"]} :poly {:main-opts ["-m" "polylith.clj.core.poly-cli.core"] :jvm-opts [;; Run RCF tests when loading files in REPL @@ -14,5 +17,5 @@ "-Dhyperfiddle.rcf.generate-tests=true"] :extra-deps {polyfy/polylith {:git/url "https://github.com/polyfy/polylith" - :sha "ccc261e60f6a875ff30858bf84cf67be105eac6f" + :sha "a073b7c8dbea176a8cb39b3c4d7c3d465c99e946" :deps/root "projects/poly"}}}}} diff --git a/projects/poly261/deps.edn b/projects/poly261/deps.edn new file mode 100644 index 0000000..161e65b --- /dev/null +++ b/projects/poly261/deps.edn @@ -0,0 +1,8 @@ +{:deps {org.clojure/clojure {:mvn/version "1.11.1"} + org.clojure/tools.deps.alpha {:mvn/version "0.12.985"} + + poly/issue-261 {:local/root "../bases/issue-261"} + poly/sqldb {:local/root "../components/sqldb"}} + + :aliases {:test {:extra-paths ["test"] + :extra-deps {}}}} diff --git a/workspace.edn b/workspace.edn index b63a7fd..6dd7861 100644 --- a/workspace.edn +++ b/workspace.edn @@ -7,4 +7,5 @@ :tag-patterns {:stable "stable-*" :release "v[0-9]*"} :projects {"development" {:alias "dev"} - "rcf" {:alias "rcf"}}} + "rcf" {:alias "rcf"} + "poly261" {:alias "poly261"}}}