From a2c3ea13eeeff4bfe0985c0d222aeb4dec0ff8b6 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 11:20:21 -0500 Subject: [PATCH 01/24] Extract out query-many-statements helper function --- src/main/lrsql/ops/query/statement.clj | 48 ++++++++++++++++---------- 1 file changed, 30 insertions(+), 18 deletions(-) diff --git a/src/main/lrsql/ops/query/statement.clj b/src/main/lrsql/ops/query/statement.clj index 0189a7165..419f00bfd 100644 --- a/src/main/lrsql/ops/query/statement.clj +++ b/src/main/lrsql/ops/query/statement.clj @@ -57,10 +57,11 @@ statement (assoc :statement statement) attachments (assoc :attachments attachments)))) -(defn- query-many-statements - "Query potentially multiple statements from the DB." - [bk tx input ltags prefix] - (let [{:keys [format limit attachments? query-params]} input +(defn- query-many-statements* + "Query multiple statements and return the (nilable) cursor to the next + statement." + [bk tx input ltags] + (let [{:keys [format limit]} input input' (if limit (update input :limit inc) input) query-results (bp/-query-statements bk tx input') ?next-cursor (when (and limit @@ -69,24 +70,35 @@ stmt-results (map (partial query-res->statement format ltags) (if (not-empty ?next-cursor) (butlast query-results) - query-results)) - att-results (if attachments? - (doall (->> (mapcat - (fn [stmt] - (->> (get stmt "id") - u/str->uuid - (assoc {} :statement-id) - (bp/-query-attachments bk tx))) - stmt-results) - dedupe-attachment-res - (map conform-attachment-res))) - [])] + query-results))] + {:statement-results stmt-results + :?next-cursor ?next-cursor})) + +(defn- query-many-statements + "Query potentially multiple statements from the DB." + [bk tx input ltags prefix] + (let [{:keys [attachments? query-params]} + input + {:keys [statement-results ?next-cursor]} + (query-many-statements* bk tx input ltags) + attachment-results + (if attachments? + (doall (->> (mapcat + (fn [stmt] + (->> (get stmt "id") + u/str->uuid + (assoc {} :statement-id) + (bp/-query-attachments bk tx))) + statement-results) + dedupe-attachment-res + (map conform-attachment-res))) + [])] {:statement-result - {:statements (vec stmt-results) + {:statements (vec statement-results) :more (if ?next-cursor (us/make-more-url query-params prefix ?next-cursor) "")} - :attachments att-results})) + :attachments attachment-results})) (s/fdef query-statements :args (s/cat :bk ss/statement-backend? From 6659d858285d77b6e393a2dfcd7508228f54f498 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 14:39:34 -0500 Subject: [PATCH 02/24] Additional refactors to statement query --- src/main/lrsql/ops/query/statement.clj | 57 ++++++++++++++------------ 1 file changed, 31 insertions(+), 26 deletions(-) diff --git a/src/main/lrsql/ops/query/statement.clj b/src/main/lrsql/ops/query/statement.clj index 419f00bfd..b3d43c6ab 100644 --- a/src/main/lrsql/ops/query/statement.clj +++ b/src/main/lrsql/ops/query/statement.clj @@ -40,19 +40,25 @@ :contentType content-type :content contents}) +(defn- query-statement-attachments + "Query all attachments associated with the ID of the `statement`." + [bk tx statement] + (->> (get statement "id") + u/str->uuid + (assoc {} :statement-id) + (bp/-query-attachments bk tx))) + (defn- query-one-statement "Query a single statement from the DB, using the `:statement-id` parameter." [bk tx input ltags] (let [{:keys [format attachments?]} input query-result (bp/-query-statement bk tx input) - statement (when query-result - (query-res->statement format ltags query-result)) - attachments (when (and statement attachments?) - (->> (get statement "id") - u/str->uuid - (assoc {} :statement-id) - (bp/-query-attachments bk tx) - (mapv conform-attachment-res)))] + statement (when query-result + (query-res->statement format ltags query-result)) + attachments (when (and statement attachments?) + (->> statement + (query-statement-attachments bk tx) + (mapv conform-attachment-res)))] (cond-> {} statement (assoc :statement statement) attachments (assoc :attachments attachments)))) @@ -62,15 +68,18 @@ statement." [bk tx input ltags] (let [{:keys [format limit]} input - input' (if limit (update input :limit inc) input) - query-results (bp/-query-statements bk tx input') - ?next-cursor (when (and limit - (= (inc limit) (count query-results))) - (-> query-results last :id u/uuid->str)) - stmt-results (map (partial query-res->statement format ltags) - (if (not-empty ?next-cursor) - (butlast query-results) - query-results))] + input* (cond-> input + (some? limit) + (update :limit inc)) + query-results (bp/-query-statements bk tx input*) + ?next-cursor (when (and limit + (= (inc limit) (count query-results))) + (-> query-results last :id u/uuid->str)) + query-results* (if (not-empty ?next-cursor) + (butlast query-results) + query-results) + stmt-results (map (partial query-res->statement format ltags) + query-results*)] {:statement-results stmt-results :?next-cursor ?next-cursor})) @@ -83,15 +92,11 @@ (query-many-statements* bk tx input ltags) attachment-results (if attachments? - (doall (->> (mapcat - (fn [stmt] - (->> (get stmt "id") - u/str->uuid - (assoc {} :statement-id) - (bp/-query-attachments bk tx))) - statement-results) - dedupe-attachment-res - (map conform-attachment-res))) + (vec (doall (->> (mapcat + (partial query-statement-attachments bk tx) + statement-results) + dedupe-attachment-res + (map conform-attachment-res)))) [])] {:statement-result {:statements (vec statement-results) From e2c6079c603485a7bc2a835ef16d61fee5a3b54d Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 14:57:20 -0500 Subject: [PATCH 03/24] Move path-related util functions to their own ns --- src/db/sqlite/lrsql/sqlite/record.clj | 6 ++-- src/main/lrsql/util/path.clj | 42 +++++++++++++++++++++++++++ src/main/lrsql/util/reaction.clj | 26 ----------------- src/test/lrsql/util/path_test.clj | 40 +++++++++++++++++++++++++ src/test/lrsql/util/reaction_test.clj | 16 ---------- 5 files changed, 85 insertions(+), 45 deletions(-) create mode 100644 src/main/lrsql/util/path.clj create mode 100644 src/test/lrsql/util/path_test.clj diff --git a/src/db/sqlite/lrsql/sqlite/record.clj b/src/db/sqlite/lrsql/sqlite/record.clj index 515368559..d6978dab6 100644 --- a/src/db/sqlite/lrsql/sqlite/record.clj +++ b/src/db/sqlite/lrsql/sqlite/record.clj @@ -6,7 +6,7 @@ [lrsql.backend.data :as bd] [lrsql.init :refer [init-hugsql-adapter!]] [lrsql.sqlite.data :as sd] - [lrsql.util.reaction :as ru]) + [lrsql.util.path :refer [path->jsonpath-string]]) (:import [org.sqlite SQLiteException SQLiteErrorCode])) ;; Init HugSql functions @@ -313,7 +313,7 @@ (-error-reaction! [_ tx params] (error-reaction! tx params)) (-snip-json-extract [_ params] - (snip-json-extract (update params :path ru/path->string))) + (snip-json-extract (update params :path path->jsonpath-string))) (-snip-val [_ params] (snip-val params)) (-snip-col [_ params] @@ -327,7 +327,7 @@ (-snip-not [_ params] (snip-not params)) (-snip-contains [_ params] - (snip-contains (update params :path ru/path->string))) + (snip-contains (update params :path path->jsonpath-string))) (-snip-query-reaction [_ params] (snip-query-reaction params)) (-query-reaction [_ tx params] diff --git a/src/main/lrsql/util/path.clj b/src/main/lrsql/util/path.clj new file mode 100644 index 000000000..c1dd1e8c7 --- /dev/null +++ b/src/main/lrsql/util/path.clj @@ -0,0 +1,42 @@ +(ns lrsql.util.path + "Utilities for property paths to query data from Statements. + Property path specs are defined in the lrs-reactions library." + (:require [clojure.spec.alpha :as s] + [clojure.string :as cstr] + [com.yetanalytics.lrs-reactions.spec :as rs])) + +(s/fdef path->jsonpath-string + :args (s/cat :path ::rs/path + :qstring (s/? string?)) + :ret string?) + +(defn path->jsonpath-string + "Given a vector of keys and/or indices, return a JSONPath string suitable for + SQL JSON access." + ([path] + (path->jsonpath-string path "$")) + ([[seg & rpath] s] + (if seg + (recur rpath + (cond + (string? seg) + (format "%s.\"%s\"" s seg) + + (nat-int? seg) + (format "%s[%d]" s seg) + + :else + (throw (ex-info "Invalid path segement" + {:type ::invalid-path-segment + :segment seg})))) + s))) + +(s/fdef path->csv-header + :args (s/cat :path ::rs/path) + :ret string?) + +(defn path->csv-header + "Given a vector of keys and/or indices, return a string of the keys + separated by underscores, suitable for use as CSV headers." + [path] + (cstr/join "_" path)) diff --git a/src/main/lrsql/util/reaction.clj b/src/main/lrsql/util/reaction.clj index 20d10f883..0d9e20e33 100644 --- a/src/main/lrsql/util/reaction.clj +++ b/src/main/lrsql/util/reaction.clj @@ -8,32 +8,6 @@ [xapi-schema.spec :as xs] [buddy.core.codecs :as bc])) -(s/fdef path->string - :args (s/cat :path ::rs/path - :qstring (s/? string?)) - :ret string?) - -(defn path->string - "Given a vector of keys and/or indices, return a JSONPath string suitable for - SQL JSON access." - ([path] - (path->string path "$")) - ([[seg & rpath] s] - (if seg - (recur rpath - (cond - (string? seg) - (format "%s.\"%s\"" s seg) - - (nat-int? seg) - (format "%s[%d]" s seg) - - :else - (throw (ex-info "Invalid path segement" - {:type ::invalid-path-segment - :segment seg})))) - s))) - (s/fdef statement-identity :args (s/cat :identityPaths ::rs/identityPaths :statement ::xs/statement) diff --git a/src/test/lrsql/util/path_test.clj b/src/test/lrsql/util/path_test.clj new file mode 100644 index 000000000..92c96887f --- /dev/null +++ b/src/test/lrsql/util/path_test.clj @@ -0,0 +1,40 @@ +(ns lrsql.util.path-test + (:require [clojure.test :refer [deftest testing are use-fixtures]] + [lrsql.util.path :as p] + [lrsql.test-support :as support])) + +(use-fixtures :once support/instrumentation-fixture) + +(deftest path->string-test + (testing "Property path to JSONPath string" + (are [input output] + (= output + (p/path->jsonpath-string input)) + [] + "$" + + ["object" "id"] + "$.\"object\".\"id\"" + + ["context" "contextActivities" "parent" 0 "id"] + "$.\"context\".\"contextActivities\".\"parent\"[0].\"id\"" + + ["context" "extensions" "https://www.google.com/array"] + "$.\"context\".\"extensions\".\"https://www.google.com/array\""))) + +(deftest path->csv-header-test + (testing "Property path to CSV header" + (are [input output] + (= output + (p/path->csv-header input)) + [] + "" + + ["object" "id"] + "object_id" + + ["context" "contextActivities" "parent" 0 "id"] + "context_contextActivities_parent_0_id" + + ["context" "extensions" "https://www.google.com/array"] + "context_extensions_https://www.google.com/array"))) diff --git a/src/test/lrsql/util/reaction_test.clj b/src/test/lrsql/util/reaction_test.clj index ed2fd71e3..652425da5 100644 --- a/src/test/lrsql/util/reaction_test.clj +++ b/src/test/lrsql/util/reaction_test.clj @@ -7,22 +7,6 @@ (use-fixtures :once support/instrumentation-fixture) -(deftest path->string-test - (are [input output] - (= output - (r/path->string input)) - [] - "$" - - ["object" "id"] - "$.\"object\".\"id\"" - - ["context" "contextActivities" "parent" 0 "id"] - "$.\"context\".\"contextActivities\".\"parent\"[0].\"id\"" - - ["context" "extensions" "https://www.google.com/array"] - "$.\"context\".\"extensions\".\"https://www.google.com/array\"")) - (def stmt-a {"actor" {"mbox" "mailto:bob@example.com"} "verb" {"id" "https://example.com/verbs/completed"} From 92471f6ecd05708733b5958f2840c9f0cb7993fc Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 18:15:54 -0500 Subject: [PATCH 04/24] Make changes to path->jsonpath functions --- src/main/lrsql/util/path.clj | 12 ++++++++++++ src/test/lrsql/util/path_test.clj | 28 +++++++++++++++++++++++----- 2 files changed, 35 insertions(+), 5 deletions(-) diff --git a/src/main/lrsql/util/path.clj b/src/main/lrsql/util/path.clj index c1dd1e8c7..28931835c 100644 --- a/src/main/lrsql/util/path.clj +++ b/src/main/lrsql/util/path.clj @@ -31,6 +31,18 @@ :segment seg})))) s))) +(s/fdef path->jsonpath-vec + :args (s/cat :path ::rs/path) + :ret vector?) + +(defn path->jsonpath-vec + "Given a vector of keys and/or indices, return a vector that is one + entry of a Pathetic-parsed JSONPath vector of vectors. + Calling `(mapv path->jsonpath-vec [path1 path2])` is equivalent to + calling `(pathetic/parse-paths \"jsonpath1 | jsonpath2\")`." + [path] + (mapv (fn [seg] [seg]) path)) + (s/fdef path->csv-header :args (s/cat :path ::rs/path) :ret string?) diff --git a/src/test/lrsql/util/path_test.clj b/src/test/lrsql/util/path_test.clj index 92c96887f..88c73fafe 100644 --- a/src/test/lrsql/util/path_test.clj +++ b/src/test/lrsql/util/path_test.clj @@ -1,15 +1,16 @@ (ns lrsql.util.path-test (:require [clojure.test :refer [deftest testing are use-fixtures]] + [com.yetanalytics.pathetic :as pa] [lrsql.util.path :as p] [lrsql.test-support :as support])) (use-fixtures :once support/instrumentation-fixture) -(deftest path->string-test +(deftest path->jsonpath-string-test (testing "Property path to JSONPath string" (are [input output] - (= output - (p/path->jsonpath-string input)) + (= (p/path->jsonpath-string input) + output) [] "$" @@ -22,11 +23,28 @@ ["context" "extensions" "https://www.google.com/array"] "$.\"context\".\"extensions\".\"https://www.google.com/array\""))) +(deftest path->jsonpath-vec-test + (testing "Property path to parsed JSONPath vector" + (are [input output] + (= [(p/path->jsonpath-vec input)] + (pa/parse-paths output)) + [] + "$" + + ["object" "id"] + "$.object.id" + + ["context" "contextActivities" "parent" 0 "id"] + "$.context.contextActivities.parent[0].id" + + ["context" "extensions" "https://www.google.com/array"] + "$.context.extensions['https://www.google.com/array']"))) + (deftest path->csv-header-test (testing "Property path to CSV header" (are [input output] - (= output - (p/path->csv-header input)) + (= (p/path->csv-header input) + output) [] "" From 994da690c25acb6d469d5301f192798221c71c62 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 18:16:08 -0500 Subject: [PATCH 05/24] Add required deps --- deps.edn | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/deps.edn b/deps.edn index 84b5ec97c..06c82be27 100644 --- a/deps.edn +++ b/deps.edn @@ -4,6 +4,7 @@ org.clojure/clojure {:mvn/version "1.11.2"} org.clojure/tools.logging {:mvn/version "1.1.0"} org.clojure/core.memoize {:mvn/version "1.0.250"} + org.clojure/data.csv {:mvn/version "1.1.0"} clojure-interop/java.security {:mvn/version "1.0.5"} org.clojure/core.async {:mvn/version "1.6.681"} ;; Util deps @@ -49,13 +50,11 @@ less-awful-ssl/less-awful-ssl {:mvn/version "1.0.6"} xyz.capybara/clamav-client {:mvn/version "2.1.2"} ;; Yet Analytics deps - com.yetanalytics/lrs {:mvn/version "1.3.0" :exclusions [org.clojure/clojure org.clojure/clojurescript com.yetanalytics/xapi-schema]} - com.yetanalytics/xapi-schema {:mvn/version "1.4.0" :exclusions [org.clojure/clojure @@ -64,15 +63,15 @@ {:mvn/version "0.1.4" :exclusions [org.clojure/clojure org.clojure/clojurescript]} + com.yetanalytics/pathetic + {:mvn/version "0.5.0"} com.yetanalytics/pedestal-oidc {:mvn/version "0.0.8" :exclusions [org.clojure/clojure buddy/buddy-sign]} - com.yetanalytics/lrs-reactions {:mvn/version "0.0.1" :exclusions [org.clojure/clojure]} - com.yetanalytics/gen-openapi {:mvn/version "0.0.4" :exclusions [org.clojure/clojure From 9fe638a8a13c94206f029c596c7f2cdec657aa18 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 18:16:40 -0500 Subject: [PATCH 06/24] Add query-all-statements function --- src/main/lrsql/ops/query/statement.clj | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/main/lrsql/ops/query/statement.clj b/src/main/lrsql/ops/query/statement.clj index b3d43c6ab..6a6bbefb5 100644 --- a/src/main/lrsql/ops/query/statement.clj +++ b/src/main/lrsql/ops/query/statement.clj @@ -127,6 +127,27 @@ (query-one-statement bk tx input ltags) (query-many-statements bk tx input ltags prefix)))) +(s/fdef query-all-statements + :args (s/cat :bk ss/statement-backend? + :tx transaction? + :input ss/statement-query-many-spec + :ltags ss/lang-tags-spec)) + +(defn query-all-statements + "Query a lazy seq of all the statements in the database, filtered by `input`. + The `:limit` parameter will dictate the size of each query batch, but will + not limit the total number of statements streamed. Ignores attachments." + [bk tx input ltags] + (let [{:keys [statement-results ?next-cursor]} + (query-many-statements* bk tx input ltags)] + (if ?next-cursor + (let [new-input (-> input + (assoc :from ?next-cursor) + (assoc-in [:query-params :from] ?next-cursor))] + (lazy-cat statement-results + (query-all-statements bk tx new-input ltags))) + statement-results))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Statement Descendant Querying ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From 247b66ccea594ee1745a34202094b5c5c2167400 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 18:16:57 -0500 Subject: [PATCH 07/24] Add statements to CSV util functions --- src/main/lrsql/util/statement.clj | 29 +++- src/test/lrsql/util/statement_test.clj | 193 +++++++++++++++---------- 2 files changed, 145 insertions(+), 77 deletions(-) diff --git a/src/main/lrsql/util/statement.clj b/src/main/lrsql/util/statement.clj index 734398e0c..1c631881b 100644 --- a/src/main/lrsql/util/statement.clj +++ b/src/main/lrsql/util/statement.clj @@ -1,7 +1,9 @@ (ns lrsql.util.statement (:require [ring.util.codec :refer [form-encode]] + [com.yetanalytics.pathetic :as pa] [com.yetanalytics.lrs.xapi.statements :as ss] - [lrsql.util :as u])) + [lrsql.util :as u] + [lrsql.util.path :as up])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Statement Preparation @@ -168,3 +170,28 @@ (cond-> query-params true (assoc :from next-cursor) ?agent (assoc :agent (u/write-json-str ?agent))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Statement CSV +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def ^:private json-path-opts + {:return-missing? true + :return-duplicates? false}) + +(defn- statement->csv-row + [json-paths statement] + (pa/get-values* statement json-paths json-path-opts)) + +(defn statements->csv-seq + "Converts a lazy `statement-seq` into a lazy seq of CSV data in the + form of vectors of vectors representing row data. The first vector + is the headers, parsed from `property-paths`." + [property-paths statements-seq] + (let [json-paths (mapv up/path->jsonpath-vec property-paths) + csv-headers (mapv up/path->csv-header property-paths) + stmt->row (partial statement->csv-row json-paths)] + (->> statements-seq + (map stmt->row) + (cons csv-headers) + lazy-seq))) diff --git a/src/test/lrsql/util/statement_test.clj b/src/test/lrsql/util/statement_test.clj index f15e34e52..42c6f10b7 100644 --- a/src/test/lrsql/util/statement_test.clj +++ b/src/test/lrsql/util/statement_test.clj @@ -1,10 +1,11 @@ (ns lrsql.util.statement-test (:require [clojure.test :refer [deftest testing is]] + [clojure.java.io :as io] [lrsql.util.statement :as su] [lrsql.util :as u])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Fixtures +;; Test Constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def sample-id @@ -55,86 +56,97 @@ "length" 27 "sha2" "495395e777cd98da653df9615d09c0fd6bb2f8d4788394cd53c56a3bfdcd848a"}) +(def lrs-authority + {"mbox" "mailto:a@example.com" + "objectType" "Agent"}) + +(def foreign-authority + {"mbox" "mailto:b@example.com" + "objectType" "Agent"}) + +(def statement-1 + {"id" sample-id + "actor" sample-group + "verb" sample-verb + "object" sample-activity}) + +(def statement-2 + {"id" sample-id + "actor" sample-group + "verb" sample-verb + "object" sample-activity + "authority" foreign-authority}) + +(def statement-3 + {"id" sample-id + "actor" sample-group + "verb" (assoc sample-verb "display" {}) + "object" (assoc sample-activity + "definition" + {"name" {} + "description" {}}) + "attachments" [(-> sample-attachment + (assoc "display" {}) + (assoc "description" {}))] + "context" {} + "result" {}}) + +(def statement-4 + {"id" sample-id + "actor" sample-group + "verb" sample-verb + "object" (assoc sample-activity + "definition" + {;; Doesn't form a valid statement but + ;; we need to test these lang maps + "choices" [{"id" "Choice" + "description" {}}] + "scale" [{"id" "Scale" + "description" {}}] + "source" [{"id" "Source" + "description" {}}] + "target" [{"id" "Target" + "description" {}}] + "steps" [{"id" "Step" + "description" {}}]})}) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tests ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (deftest prepare-statement-test - (let [lrs-authority {"mbox" "mailto:a@example.com" - "objectType" "Agent"} - foreign-authority {"mbox" "mailto:b@example.com" - "objectType" "Agent"} - ;; Statements - statement-1 {"id" sample-id - "actor" sample-group - "verb" sample-verb - "object" sample-activity} - statement-2 {"id" sample-id - "actor" sample-group - "verb" sample-verb - "object" sample-activity - "authority" foreign-authority} - statement-3 {"id" sample-id - "actor" sample-group - "verb" (assoc sample-verb "display" {}) - "object" (assoc sample-activity - "definition" - {"name" {} - "description" {}}) - "attachments" [(-> sample-attachment - (assoc "display" {}) - (assoc "description" {}))] - "context" {} - "result" {}} - statement-4 {"id" sample-id - "actor" sample-group - "verb" sample-verb - "object" (assoc sample-activity - "definition" - {;; Doesn't form a valid statement but - ;; we need to test these lang maps - "choices" [{"id" "Choice" - "description" {}}] - "scale" [{"id" "Scale" - "description" {}}] - "source" [{"id" "Source" - "description" {}}] - "target" [{"id" "Target" - "description" {}}] - "steps" [{"id" "Step" - "description" {}}]})}] - (testing "adds timestamp, stored, version, and authority" - (let [statement* (su/prepare-statement lrs-authority statement-1)] - (is (inst? (u/str->time (get statement* "timestamp")))) - (is (inst? (u/str->time (get statement* "stored")))) - (is (= su/xapi-version (get statement* "version"))) - (is (= lrs-authority (get statement* "authority"))))) - (testing "overwrites authority" - (is (= lrs-authority - (-> (su/prepare-statement lrs-authority statement-2) - (get "authority"))))) - (testing "dissocs empty maps" - (is (= {"id" sample-id - "actor" sample-group - "verb" sample-verb-dissoc - "object" sample-activity-dissoc - "attachments" [(dissoc sample-attachment - "display" - "description")]} - (-> (su/prepare-statement lrs-authority statement-3) - (dissoc "timestamp" "stored" "authority" "version")))) - (is (= {"id" sample-id - "actor" sample-group - "verb" sample-verb - "object" (assoc sample-activity - "definition" - {"choices" [{"id" "Choice"}] - "scale" [{"id" "Scale"}] - "source" [{"id" "Source"}] - "target" [{"id" "Target"}] - "steps" [{"id" "Step"}]})} - (-> (su/prepare-statement lrs-authority statement-4) - (dissoc "timestamp" "stored" "authority" "version"))))))) + (testing "adds timestamp, stored, version, and authority" + (let [statement* (su/prepare-statement lrs-authority statement-1)] + (is (inst? (u/str->time (get statement* "timestamp")))) + (is (inst? (u/str->time (get statement* "stored")))) + (is (= su/xapi-version (get statement* "version"))) + (is (= lrs-authority (get statement* "authority"))))) + (testing "overwrites authority" + (is (= lrs-authority + (-> (su/prepare-statement lrs-authority statement-2) + (get "authority"))))) + (testing "dissocs empty maps" + (is (= {"id" sample-id + "actor" sample-group + "verb" sample-verb-dissoc + "object" sample-activity-dissoc + "attachments" [(dissoc sample-attachment + "display" + "description")]} + (-> (su/prepare-statement lrs-authority statement-3) + (dissoc "timestamp" "stored" "authority" "version")))) + (is (= {"id" sample-id + "actor" sample-group + "verb" sample-verb + "object" (assoc sample-activity + "definition" + {"choices" [{"id" "Choice"}] + "scale" [{"id" "Scale"}] + "source" [{"id" "Source"}] + "target" [{"id" "Target"}] + "steps" [{"id" "Step"}]})} + (-> (su/prepare-statement lrs-authority statement-4) + (dissoc "timestamp" "stored" "authority" "version")))))) (deftest statements-equal-test (testing "statement equality" @@ -255,3 +267,32 @@ sample-activity] "other" [sample-activity sample-activity]}}}}))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; CSV +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(deftest statements->csv-seq-test + (testing "Turn statements seq into CSV seq" + (let [headers [["id"] + ["actor" "mbox"] + ["verb" "id"] + ["object" "id"]] + statements (lazy-cat [statement-1 + statement-2] + [statement-3 + statement-4]) + stream (su/statements->csv-seq headers statements)] + (is (not (realized? stream))) + (is (= ["id" "actor_mbox" "verb_id" "object_id"] + (first stream))) + (is (= [sample-id + (get sample-group "mbox") + (get sample-verb "id") + (get sample-activity "id")] + (first (-> stream rest)) + (first (-> stream rest rest)) + (first (-> stream rest rest rest)) + (first (-> stream rest rest rest rest)))) + (is (nil? (first (-> stream rest rest rest rest rest)))) + (is (realized? stream))))) From d60579a23d8caeb837565986050aff2271c1d6c7 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 18:17:19 -0500 Subject: [PATCH 08/24] Implement get-statements-csv protocol function --- src/main/lrsql/admin/protocol.clj | 3 +- src/main/lrsql/system/lrs.clj | 14 +++++++-- src/test/lrsql/admin/protocol_test.clj | 39 ++++++++++++++++++++++++++ 3 files changed, 52 insertions(+), 4 deletions(-) diff --git a/src/main/lrsql/admin/protocol.clj b/src/main/lrsql/admin/protocol.clj index 4dbf6766a..ed27dd6e7 100644 --- a/src/main/lrsql/admin/protocol.clj +++ b/src/main/lrsql/admin/protocol.clj @@ -43,4 +43,5 @@ "Soft-delete a reaction.")) (defprotocol AdminLRSManager - (-delete-actor [this params])) + (-delete-actor [this params]) + (-get-statements-csv [this csv-headers params])) diff --git a/src/main/lrsql/system/lrs.clj b/src/main/lrsql/system/lrs.clj index e5851824f..b261bc78c 100644 --- a/src/main/lrsql/system/lrs.clj +++ b/src/main/lrsql/system/lrs.clj @@ -151,7 +151,6 @@ stmt-res)))) ;; No more statement inputs - return stmt-res))))) - (-get-statements [lrs auth-identity params ltags] (let [conn (lrs-conn lrs) @@ -395,7 +394,16 @@ adp/AdminLRSManager (-delete-actor [this {:keys [actor-ifi]}] - (let [conn (lrs-conn this) + (let [conn (lrs-conn this) input (agent-input/delete-actor-input actor-ifi)] (jdbc/with-transaction [tx conn] - (stmt-cmd/delete-actor! backend tx input))))) + (stmt-cmd/delete-actor! backend tx input)))) + (-get-statements-csv [lrs headers params] + (let [conn (lrs-conn lrs)] + (jdbc/with-transaction [tx conn] + (let [config (:config lrs) + input (-> params ; TODO: Higher limit for CSV stream? + (stmt-util/ensure-default-max-limit config) + (stmt-input/query-statement-input nil)) + stmt-seq (stmt-q/query-all-statements backend tx input {})] + (stmt-util/statements->csv-seq headers stmt-seq)))))) diff --git a/src/test/lrsql/admin/protocol_test.clj b/src/test/lrsql/admin/protocol_test.clj index 6ed1bab84..bdbcfa69b 100644 --- a/src/test/lrsql/admin/protocol_test.clj +++ b/src/test/lrsql/admin/protocol_test.clj @@ -263,6 +263,45 @@ (is (empty? (arb-query ["select * from statement_to_activity where statement_id = ?" stmt-id])))))))) (finally (component/stop sys'))))) +(deftest download-csv-test + (let [sys (support/test-system) + sys' (component/start sys) + lrs (:lrs sys') + hdrs [["id"] ["actor" "mbox"] ["verb" "id"] ["object" "id"]]] + (try + (lrsp/-store-statements lrs auth-ident [stmt-0 stmt-1] []) + (testing "CSV Seq - no params" + (let [stmt-seq (adp/-get-statements-csv lrs hdrs {})] + (is (not (realized? stmt-seq))) + (is (= ["id" "actor_mbox" "verb_id" "object_id"] + (first stmt-seq))) + (is (= [(get stmt-1 "id") + (get-in stmt-1 ["actor" "mbox"]) + (get-in stmt-1 ["verb" "id"]) + (get-in stmt-1 ["object" "id"])] + (first (rest stmt-seq)))) + (is (= [(get stmt-0 "id") + (get-in stmt-0 ["actor" "mbox"]) + (get-in stmt-0 ["verb" "id"]) + (get-in stmt-0 ["object" "id"])] + (first (rest (rest stmt-seq))))))) + (testing "CSV Seq - ascending set to true" + (let [stmt-seq (adp/-get-statements-csv lrs hdrs {:ascending true})] + (is (not (realized? stmt-seq))) + (is (= ["id" "actor_mbox" "verb_id" "object_id"] + (first stmt-seq))) + (is (= [(get stmt-0 "id") + (get-in stmt-0 ["actor" "mbox"]) + (get-in stmt-0 ["verb" "id"]) + (get-in stmt-0 ["object" "id"])] + (first (rest stmt-seq)))) + (is (= [(get stmt-1 "id") + (get-in stmt-1 ["actor" "mbox"]) + (get-in stmt-1 ["verb" "id"]) + (get-in stmt-1 ["object" "id"])] + (first (rest (rest stmt-seq))))))) + (finally (component/stop sys'))))) + ;; TODO: Add tests for creds with no explicit scopes, once ;; `statements/read/mine` is implemented From df178d6cd45333a4fe1ebca9b6def21e8f5f7c9c Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 11 Feb 2025 18:21:40 -0500 Subject: [PATCH 09/24] Remove unused require --- src/test/lrsql/util/statement_test.clj | 1 - 1 file changed, 1 deletion(-) diff --git a/src/test/lrsql/util/statement_test.clj b/src/test/lrsql/util/statement_test.clj index 42c6f10b7..7c118cfa3 100644 --- a/src/test/lrsql/util/statement_test.clj +++ b/src/test/lrsql/util/statement_test.clj @@ -1,6 +1,5 @@ (ns lrsql.util.statement-test (:require [clojure.test :refer [deftest testing is]] - [clojure.java.io :as io] [lrsql.util.statement :as su] [lrsql.util :as u])) From 40530f47936d6aa73d22272d4a4479e5a6edbff0 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Wed, 12 Feb 2025 11:42:15 -0500 Subject: [PATCH 10/24] Only put quotes in SQL JSON path strings when needed --- src/db/sqlite/lrsql/sqlite/record.clj | 6 +++--- src/main/lrsql/util/path.clj | 21 +++++++++++++++------ src/test/lrsql/util/path_test.clj | 12 ++++++------ 3 files changed, 24 insertions(+), 15 deletions(-) diff --git a/src/db/sqlite/lrsql/sqlite/record.clj b/src/db/sqlite/lrsql/sqlite/record.clj index d6978dab6..779e60c5d 100644 --- a/src/db/sqlite/lrsql/sqlite/record.clj +++ b/src/db/sqlite/lrsql/sqlite/record.clj @@ -6,7 +6,7 @@ [lrsql.backend.data :as bd] [lrsql.init :refer [init-hugsql-adapter!]] [lrsql.sqlite.data :as sd] - [lrsql.util.path :refer [path->jsonpath-string]]) + [lrsql.util.path :refer [path->sqlpath-string]]) (:import [org.sqlite SQLiteException SQLiteErrorCode])) ;; Init HugSql functions @@ -313,7 +313,7 @@ (-error-reaction! [_ tx params] (error-reaction! tx params)) (-snip-json-extract [_ params] - (snip-json-extract (update params :path path->jsonpath-string))) + (snip-json-extract (update params :path path->sqlpath-string))) (-snip-val [_ params] (snip-val params)) (-snip-col [_ params] @@ -327,7 +327,7 @@ (-snip-not [_ params] (snip-not params)) (-snip-contains [_ params] - (snip-contains (update params :path path->jsonpath-string))) + (snip-contains (update params :path path->sqlpath-string))) (-snip-query-reaction [_ params] (snip-query-reaction params)) (-query-reaction [_ tx params] diff --git a/src/main/lrsql/util/path.clj b/src/main/lrsql/util/path.clj index 28931835c..22c909eea 100644 --- a/src/main/lrsql/util/path.clj +++ b/src/main/lrsql/util/path.clj @@ -5,21 +5,30 @@ [clojure.string :as cstr] [com.yetanalytics.lrs-reactions.spec :as rs])) -(s/fdef path->jsonpath-string +(defn- alpha-only? + [s] + (re-matches #"[A-Za-z]*" s)) + +(s/fdef path->sqlpath-string :args (s/cat :path ::rs/path :qstring (s/? string?)) :ret string?) -(defn path->jsonpath-string - "Given a vector of keys and/or indices, return a JSONPath string suitable for - SQL JSON access." +(defn path->sqlpath-string + "Given a vector of keys and/or indices, return a JSONPath-like string suitable + for SQL JSON access. Unlike JSONPath strings themselves, all string keys + require the dot syntax." ([path] - (path->jsonpath-string path "$")) + (path->sqlpath-string path "$")) ([[seg & rpath] s] (if seg (recur rpath (cond - (string? seg) + (and (string? seg) + (alpha-only? seg)) + (format "%s.%s" s seg) + + (string? seg) ; URLs and other special-character containing strs (format "%s.\"%s\"" s seg) (nat-int? seg) diff --git a/src/test/lrsql/util/path_test.clj b/src/test/lrsql/util/path_test.clj index 88c73fafe..184fb0ee0 100644 --- a/src/test/lrsql/util/path_test.clj +++ b/src/test/lrsql/util/path_test.clj @@ -6,22 +6,22 @@ (use-fixtures :once support/instrumentation-fixture) -(deftest path->jsonpath-string-test - (testing "Property path to JSONPath string" +(deftest path->sqlpath-string-test + (testing "Property path to JSONPath-like string for SQL" (are [input output] - (= (p/path->jsonpath-string input) + (= (p/path->sqlpath-string input) output) [] "$" ["object" "id"] - "$.\"object\".\"id\"" + "$.object.id" ["context" "contextActivities" "parent" 0 "id"] - "$.\"context\".\"contextActivities\".\"parent\"[0].\"id\"" + "$.context.contextActivities.parent[0].id" ["context" "extensions" "https://www.google.com/array"] - "$.\"context\".\"extensions\".\"https://www.google.com/array\""))) + "$.context.extensions.\"https://www.google.com/array\""))) (deftest path->jsonpath-vec-test (testing "Property path to parsed JSONPath vector" From 8d06741fb4440e4a9fb7e96ec59c2279d8202f8d Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Wed, 12 Feb 2025 16:54:58 -0500 Subject: [PATCH 11/24] Change some arg names --- src/main/lrsql/admin/protocol.clj | 2 +- src/main/lrsql/system/lrs.clj | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/main/lrsql/admin/protocol.clj b/src/main/lrsql/admin/protocol.clj index ed27dd6e7..3a26cc262 100644 --- a/src/main/lrsql/admin/protocol.clj +++ b/src/main/lrsql/admin/protocol.clj @@ -44,4 +44,4 @@ (defprotocol AdminLRSManager (-delete-actor [this params]) - (-get-statements-csv [this csv-headers params])) + (-get-statements-csv [this property-paths params])) diff --git a/src/main/lrsql/system/lrs.clj b/src/main/lrsql/system/lrs.clj index b261bc78c..6b83bf074 100644 --- a/src/main/lrsql/system/lrs.clj +++ b/src/main/lrsql/system/lrs.clj @@ -398,7 +398,7 @@ input (agent-input/delete-actor-input actor-ifi)] (jdbc/with-transaction [tx conn] (stmt-cmd/delete-actor! backend tx input)))) - (-get-statements-csv [lrs headers params] + (-get-statements-csv [lrs property-paths params] (let [conn (lrs-conn lrs)] (jdbc/with-transaction [tx conn] (let [config (:config lrs) @@ -406,4 +406,4 @@ (stmt-util/ensure-default-max-limit config) (stmt-input/query-statement-input nil)) stmt-seq (stmt-q/query-all-statements backend tx input {})] - (stmt-util/statements->csv-seq headers stmt-seq)))))) + (stmt-util/statements->csv-seq property-paths stmt-seq)))))) From 1c742b3adbd01adc131fa9c5f32e992e01a674f8 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Wed, 12 Feb 2025 16:55:15 -0500 Subject: [PATCH 12/24] Implement CSV download interceptor and endpoint --- .../admin/interceptors/lrs_management.clj | 71 ++++++++++++++++++- src/main/lrsql/admin/routes.clj | 12 +++- src/test/lrsql/admin/route_test.clj | 17 +++++ 3 files changed, 97 insertions(+), 3 deletions(-) diff --git a/src/main/lrsql/admin/interceptors/lrs_management.clj b/src/main/lrsql/admin/interceptors/lrs_management.clj index 76f326ebb..bcc4fddd8 100644 --- a/src/main/lrsql/admin/interceptors/lrs_management.clj +++ b/src/main/lrsql/admin/interceptors/lrs_management.clj @@ -1,9 +1,19 @@ (ns lrsql.admin.interceptors.lrs-management (:require [clojure.spec.alpha :as s] + [clojure.data.csv :as csv] + [clojure.edn :as edn] + [clojure.java.io :as io] [io.pedestal.interceptor :refer [interceptor]] [io.pedestal.interceptor.chain :as chain] [lrsql.admin.protocol :as adp] - [lrsql.spec.admin :as ads])) + [lrsql.spec.admin :as ads] + [com.yetanalytics.lrs.pedestal.interceptor.xapi :as i-xapi] + [com.yetanalytics.lrs-reactions.spec :as rs]) + (:import [javax.servlet ServletOutputStream])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Actor Delete +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def validate-delete-actor-params (interceptor @@ -31,3 +41,62 @@ (assoc ctx :response {:status 200 :body params})))})) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; CSV Download +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def validate-property-paths + (interceptor + {:name ::validate-property-paths + :enter + (fn validate-property-paths [ctx] + (let [property-paths (-> ctx + (get-in [:request + :params + :property-paths]) + edn/read-string)] + (if-some [e (s/explain-data (s/every ::rs/path) property-paths)] + (assoc (chain/terminate ctx) + :response + {:status 400 + :body {:error (format "Invalid property paths:\n%s" + (-> e s/explain-out with-out-str))}}) + ;; Need to dissoc since lrs.pedestal.interceptor.xapi/params-interceptor + ;; restricts allowed keys in the query param map. + (-> ctx + (update-in [:request :params] dissoc :property-paths) + (update-in [:request :query-params] dissoc :property-paths) + (assoc-in [:request :property-paths] property-paths)))))})) + +(def validate-query-params + (interceptor + (i-xapi/params-interceptor :xapi.statements.GET.request/params))) + +(def csv-response-header + {"Content-Type" "text/csv" + "Content-Disposition" "attachment"}) + +(defn- stream-csv + [csv-data-seq] + (fn [^ServletOutputStream os] + (with-open [writer (io/writer os)] + (csv/write-csv writer csv-data-seq :newline :cr+lf)))) + +(def download-statement-csv + (interceptor + {:name ::download-statement-csv + :enter + (fn download-statement-csv [ctx] + (let [{lrs :com.yetanalytics/lrs + request :request} + ctx + {:keys [property-paths query-params]} + request + csv-data-seq (adp/-get-statements-csv lrs + property-paths + query-params)] + (assoc ctx + :response {:status 200 + :headers csv-response-header + :body (stream-csv csv-data-seq)})))})) diff --git a/src/main/lrsql/admin/routes.clj b/src/main/lrsql/admin/routes.clj index 170d9022e..79893f071 100644 --- a/src/main/lrsql/admin/routes.clj +++ b/src/main/lrsql/admin/routes.clj @@ -262,13 +262,21 @@ ri/delete-reaction) :route-name :lrsql.admin.reaction/delete]}) -(defn admin-lrs-management-routes [common-interceptors jwt-secret jwt-leeway no-val-opts] +(defn admin-lrs-management-routes + [common-interceptors jwt-secret jwt-leeway no-val-opts] #{["/admin/agents" :delete (conj common-interceptors lm/validate-delete-actor-params (ji/validate-jwt jwt-secret jwt-leeway no-val-opts) ji/validate-jwt-account lm/delete-actor) - :route-name :lrsql.lrs-management/delete-actor]}) + :route-name :lrsql.lrs-management/delete-actor] + ["/admin/csv" :get (conj common-interceptors + lm/validate-property-paths + lm/validate-query-params + (ji/validate-jwt jwt-secret jwt-leeway no-val-opts) + ji/validate-jwt-account + lm/download-statement-csv) + :route-name :lrsql.lrs-management/download-csv]}) (defn add-admin-routes "Given a set of routes `routes` for a default LRS implementation, diff --git a/src/test/lrsql/admin/route_test.clj b/src/test/lrsql/admin/route_test.clj index 8ec278a5b..cec7af601 100644 --- a/src/test/lrsql/admin/route_test.clj +++ b/src/test/lrsql/admin/route_test.clj @@ -4,6 +4,7 @@ (:require [clojure.test :refer [deftest testing is use-fixtures are]] [clojure.string :refer [lower-case]] [babashka.curl :as curl] + [ring.util.codec :refer [url-encode]] [com.stuartsierra.component :as component] [xapi-schema.spec.regex :refer [Base64RegEx]] [com.yetanalytics.lrs.protocol :as lrsp] @@ -284,6 +285,22 @@ "new-password" orig-pass}) :status (= 200)))))) + (testing "download CSV data" + (let [property-paths-vec [["id"] ["actor" "mbox"]] + property-paths-str (url-encode (str property-paths-vec)) + endpoint-url (format "http://0.0.0.0:8080/admin/csv?property-paths=%s&ascending=true" + property-paths-str) + {:keys [status body]} (curl/get endpoint-url + {:headers headers + :as :stream}) + csv-body (slurp body)] + (is (= 200 status)) + (is (= "id,actor_mbox\r\n" csv-body))) + (let [bad-prop-path (->> ["zoo" "wee" "mama"] str url-encode) + bad-url (format "http://0.0.0.0:8080/admin/csv?property-paths=%s" + bad-prop-path)] + (is-err-code (curl/get bad-url {:headers headers :as :stream}) + 400))) (testing "delete the `myname` account using the seed account" (let [del-jwt (-> (login-account content-type req-body) :body From 7ec555afb37252324ae9e28d8412e87a88c70b85 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Fri, 14 Feb 2025 16:32:52 -0500 Subject: [PATCH 13/24] Disable JWT validation for /admin/csv endpoint --- src/main/lrsql/admin/routes.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/lrsql/admin/routes.clj b/src/main/lrsql/admin/routes.clj index 79893f071..7ac99851f 100644 --- a/src/main/lrsql/admin/routes.clj +++ b/src/main/lrsql/admin/routes.clj @@ -273,8 +273,8 @@ ["/admin/csv" :get (conj common-interceptors lm/validate-property-paths lm/validate-query-params - (ji/validate-jwt jwt-secret jwt-leeway no-val-opts) - ji/validate-jwt-account + #_(ji/validate-jwt jwt-secret jwt-leeway no-val-opts) + #_ji/validate-jwt-account lm/download-statement-csv) :route-name :lrsql.lrs-management/download-csv]}) From 5fce0e3dea981e208722a6be13bd2f0d0d63c6f0 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Fri, 14 Feb 2025 16:33:51 -0500 Subject: [PATCH 14/24] Use next.jdbc/plan and test queries beyond :limit --- src/db/postgres/lrsql/postgres/record.clj | 9 +++ src/db/sqlite/lrsql/sqlite/record.clj | 7 +- .../admin/interceptors/lrs_management.clj | 22 +++--- src/main/lrsql/admin/protocol.clj | 2 +- src/main/lrsql/backend/protocol.clj | 1 + src/main/lrsql/ops/query/statement.clj | 51 +++++++++--- src/main/lrsql/system/lrs.clj | 23 +++--- src/main/lrsql/util/statement.clj | 12 ++- src/test/lrsql/admin/protocol_test.clj | 78 +++++++++++-------- 9 files changed, 138 insertions(+), 67 deletions(-) diff --git a/src/db/postgres/lrsql/postgres/record.clj b/src/db/postgres/lrsql/postgres/record.clj index 16e8a6f74..f0f2a86b6 100644 --- a/src/db/postgres/lrsql/postgres/record.clj +++ b/src/db/postgres/lrsql/postgres/record.clj @@ -1,6 +1,7 @@ (ns lrsql.postgres.record (:require [com.stuartsierra.component :as cmp] [hugsql.core :as hug] + [next.jdbc :as jdbc] [lrsql.backend.data :as bd] [lrsql.backend.protocol :as bp] [lrsql.init :refer [init-hugsql-adapter!]] @@ -18,6 +19,8 @@ (hug/def-db-fns "lrsql/postgres/sql/update.sql") (hug/def-db-fns "lrsql/postgres/sql/delete.sql") +(hug/def-sqlvec-fns "lrsql/postgres/sql/query.sql") + ;; Define record #_{:clj-kondo/ignore [:unresolved-symbol]} ; Shut up VSCode warnings (defrecord PostgresBackend [tuning] @@ -102,6 +105,12 @@ (query-statement-exists tx input)) (-query-statement-descendants [_ tx input] (query-statement-descendants tx input)) + (-query-statements-lazy [_ tx input] + (let [sqlvec (query-statements-sqlvec input)] + (jdbc/plan tx sqlvec {:fetch-size 4000 + :concurrency :read-only + :cursors :close + :result-type :forward-only}))) bp/ActorBackend (-insert-actor! [_ tx input] diff --git a/src/db/sqlite/lrsql/sqlite/record.clj b/src/db/sqlite/lrsql/sqlite/record.clj index 779e60c5d..fbd4e3cf0 100644 --- a/src/db/sqlite/lrsql/sqlite/record.clj +++ b/src/db/sqlite/lrsql/sqlite/record.clj @@ -2,6 +2,7 @@ (:require [clojure.tools.logging :as log] [com.stuartsierra.component :as cmp] [hugsql.core :as hug] + [next.jdbc :as jdbc] [lrsql.backend.protocol :as bp] [lrsql.backend.data :as bd] [lrsql.init :refer [init-hugsql-adapter!]] @@ -19,6 +20,8 @@ (hug/def-db-fns "lrsql/sqlite/sql/update.sql") (hug/def-db-fns "lrsql/sqlite/sql/delete.sql") +(hug/def-sqlvec-fns "lrsql/sqlite/sql/query.sql") + ;; Schema Update Helpers #_{:clj-kondo/ignore [:unresolved-symbol]} @@ -135,6 +138,9 @@ (query-statement-exists tx input)) (-query-statement-descendants [_ tx input] (query-statement-descendants tx input)) + (-query-statements-lazy [_ tx input] + (let [sqlvec (query-statements-sqlvec input)] + (jdbc/plan tx sqlvec))) bp/ActorBackend (-insert-actor! [_ tx input] @@ -151,7 +157,6 @@ (delete-actor-agent-profile tx input) (delete-actor-state-document tx input) (delete-actor-actor tx input)) - (-query-actor [_ tx input] (query-actor tx input)) diff --git a/src/main/lrsql/admin/interceptors/lrs_management.clj b/src/main/lrsql/admin/interceptors/lrs_management.clj index bcc4fddd8..c879f6075 100644 --- a/src/main/lrsql/admin/interceptors/lrs_management.clj +++ b/src/main/lrsql/admin/interceptors/lrs_management.clj @@ -77,12 +77,6 @@ {"Content-Type" "text/csv" "Content-Disposition" "attachment"}) -(defn- stream-csv - [csv-data-seq] - (fn [^ServletOutputStream os] - (with-open [writer (io/writer os)] - (csv/write-csv writer csv-data-seq :newline :cr+lf)))) - (def download-statement-csv (interceptor {:name ::download-statement-csv @@ -92,11 +86,13 @@ request :request} ctx {:keys [property-paths query-params]} - request - csv-data-seq (adp/-get-statements-csv lrs - property-paths - query-params)] + request] (assoc ctx - :response {:status 200 - :headers csv-response-header - :body (stream-csv csv-data-seq)})))})) + :response + {:status 200 + :headers csv-response-header + :body (fn [^ServletOutputStream os] + (adp/-get-statements-csv lrs + os + property-paths + query-params))})))})) diff --git a/src/main/lrsql/admin/protocol.clj b/src/main/lrsql/admin/protocol.clj index 3a26cc262..ed7dbec05 100644 --- a/src/main/lrsql/admin/protocol.clj +++ b/src/main/lrsql/admin/protocol.clj @@ -44,4 +44,4 @@ (defprotocol AdminLRSManager (-delete-actor [this params]) - (-get-statements-csv [this property-paths params])) + (-get-statements-csv [this writer property-paths params])) diff --git a/src/main/lrsql/backend/protocol.clj b/src/main/lrsql/backend/protocol.clj index 1c95aba36..eacd94e45 100644 --- a/src/main/lrsql/backend/protocol.clj +++ b/src/main/lrsql/backend/protocol.clj @@ -30,6 +30,7 @@ ;; Queries (-query-statement [this tx input]) (-query-statements [this tx input]) + (-query-statements-lazy [this tx input]) (-query-statement-exists [this tx input]) (-query-statement-descendants [this tx input])) diff --git a/src/main/lrsql/ops/query/statement.clj b/src/main/lrsql/ops/query/statement.clj index 6a6bbefb5..b8b151b41 100644 --- a/src/main/lrsql/ops/query/statement.clj +++ b/src/main/lrsql/ops/query/statement.clj @@ -1,5 +1,7 @@ (ns lrsql.ops.query.statement (:require [clojure.spec.alpha :as s] + [clojure.java.io :as io] + [clojure.data.csv :as csv] [com.yetanalytics.lrs.protocol :as lrsp] [lrsql.backend.protocol :as bp] [lrsql.spec.common :refer [transaction?]] @@ -74,8 +76,8 @@ query-results (bp/-query-statements bk tx input*) ?next-cursor (when (and limit (= (inc limit) (count query-results))) - (-> query-results last :id u/uuid->str)) - query-results* (if (not-empty ?next-cursor) + (-> query-results last :id)) + query-results* (if (some? ?next-cursor) (butlast query-results) query-results) stmt-results (map (partial query-res->statement format ltags) @@ -127,25 +129,54 @@ (query-one-statement bk tx input ltags) (query-many-statements bk tx input ltags prefix)))) -(s/fdef query-all-statements +#_(s/fdef query-all-statements :args (s/cat :bk ss/statement-backend? :tx transaction? :input ss/statement-query-many-spec - :ltags ss/lang-tags-spec)) + :ltags ss/lang-tags-spec + :property-paths vector?)) (defn query-all-statements "Query a lazy seq of all the statements in the database, filtered by `input`. The `:limit` parameter will dictate the size of each query batch, but will not limit the total number of statements streamed. Ignores attachments." - [bk tx input ltags] - (let [{:keys [statement-results ?next-cursor]} + [bk tx input ltags property-paths writeable] + (let [format (:format input) + input (-> input + (dissoc :from :query-params) + (assoc :limit 1000000)) + json-paths (us/property-paths->json-paths property-paths) + csv-headers (us/property-paths->csv-headers property-paths)] + (with-open [writer (io/writer writeable)] + (csv/write-csv writer [csv-headers] :newline :cr+lf) + (transduce (comp (map (fn [res] + (query-res->statement format ltags res))) + (map (fn [stmt] + (us/statement->csv-row json-paths stmt)))) + (fn write-csv-reducer + ([writer] + writer) + ([writer row] + (csv/write-csv writer [row] :newline :cr+lf) + writer)) + writer + (bp/-query-statements-lazy bk tx input)) + #_(->> (bp/-query-statements-lazy bk tx input) + #_(map format-fn result) + (into []) + #_(us/statements->csv-seq property-paths) + #_(reduce (fn [writer row] + (csv/write-csv writer [row] :newline :cr+lf)) + writer)))) + #_(let [{:keys [statement-results ?next-cursor]} (query-many-statements* bk tx input ltags)] (if ?next-cursor - (let [new-input (-> input + (let [next-str (u/uuid->str ?next-cursor) + new-input (-> input (assoc :from ?next-cursor) - (assoc-in [:query-params :from] ?next-cursor))] - (lazy-cat statement-results - (query-all-statements bk tx new-input ltags))) + (assoc-in [:query-params :from] next-str))] + (concat statement-results + (lazy-seq (query-all-statements bk tx new-input ltags property-paths)))) statement-results))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/main/lrsql/system/lrs.clj b/src/main/lrsql/system/lrs.clj index 6b83bf074..ff1526d36 100644 --- a/src/main/lrsql/system/lrs.clj +++ b/src/main/lrsql/system/lrs.clj @@ -398,12 +398,17 @@ input (agent-input/delete-actor-input actor-ifi)] (jdbc/with-transaction [tx conn] (stmt-cmd/delete-actor! backend tx input)))) - (-get-statements-csv [lrs property-paths params] - (let [conn (lrs-conn lrs)] - (jdbc/with-transaction [tx conn] - (let [config (:config lrs) - input (-> params ; TODO: Higher limit for CSV stream? - (stmt-util/ensure-default-max-limit config) - (stmt-input/query-statement-input nil)) - stmt-seq (stmt-q/query-all-statements backend tx input {})] - (stmt-util/statements->csv-seq property-paths stmt-seq)))))) + (-get-statements-csv [lrs output-stream property-paths params] + (let [conn (lrs-conn lrs) + config (:config lrs) + input (-> params ; TODO: Higher limit for CSV stream? + (stmt-util/ensure-default-max-limit config) + (stmt-input/query-statement-input nil))] + (stmt-q/query-all-statements backend + conn + input + {} + property-paths + output-stream) + #_(jdbc/with-transaction [tx conn] + (stmt-q/query-all-statements backend tx input {} property-paths))))) diff --git a/src/main/lrsql/util/statement.clj b/src/main/lrsql/util/statement.clj index 1c631881b..c21acf77f 100644 --- a/src/main/lrsql/util/statement.clj +++ b/src/main/lrsql/util/statement.clj @@ -168,7 +168,7 @@ "/statements?" (form-encode (cond-> query-params - true (assoc :from next-cursor) + true (assoc :from (u/uuid->str next-cursor)) ?agent (assoc :agent (u/write-json-str ?agent))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -179,7 +179,15 @@ {:return-missing? true :return-duplicates? false}) -(defn- statement->csv-row +(defn property-paths->json-paths + [property-paths] + (mapv up/path->jsonpath-vec property-paths)) + +(defn property-paths->csv-headers + [property-paths] + (mapv up/path->csv-header property-paths)) + +(defn statement->csv-row [json-paths statement] (pa/get-values* statement json-paths json-path-opts)) diff --git a/src/test/lrsql/admin/protocol_test.clj b/src/test/lrsql/admin/protocol_test.clj index bdbcfa69b..c043607c7 100644 --- a/src/test/lrsql/admin/protocol_test.clj +++ b/src/test/lrsql/admin/protocol_test.clj @@ -1,15 +1,17 @@ (ns lrsql.admin.protocol-test "Test the protocol fns of `AdminAccountManager`, `APIKeyManager`, `AdminStatusProvider` directly." (:require [clojure.test :refer [deftest testing is use-fixtures]] - [com.stuartsierra.component :as component] + [clojure.data.csv :as csv] + [next.jdbc :as jdbc] + [com.stuartsierra.component :as component] + [com.yetanalytics.squuid :as squuid] [com.yetanalytics.lrs.protocol :as lrsp] [xapi-schema.spec.regex :refer [Base64RegEx]] [lrsql.admin.protocol :as adp] - [lrsql.lrs-test :as lrst] + [lrsql.lrs-test :as lrst] [lrsql.test-support :as support] [lrsql.util :as u] [lrsql.test-constants :as tc] - [next.jdbc :as jdbc] [lrsql.util.actor :as ua])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -271,35 +273,49 @@ (try (lrsp/-store-statements lrs auth-ident [stmt-0 stmt-1] []) (testing "CSV Seq - no params" - (let [stmt-seq (adp/-get-statements-csv lrs hdrs {})] - (is (not (realized? stmt-seq))) - (is (= ["id" "actor_mbox" "verb_id" "object_id"] - (first stmt-seq))) - (is (= [(get stmt-1 "id") - (get-in stmt-1 ["actor" "mbox"]) - (get-in stmt-1 ["verb" "id"]) - (get-in stmt-1 ["object" "id"])] - (first (rest stmt-seq)))) - (is (= [(get stmt-0 "id") - (get-in stmt-0 ["actor" "mbox"]) - (get-in stmt-0 ["verb" "id"]) - (get-in stmt-0 ["object" "id"])] - (first (rest (rest stmt-seq))))))) + (with-open [writer (java.io.StringWriter.)] + (adp/-get-statements-csv lrs writer hdrs {}) + (let [stmt-str (str writer) + stmt-seq (csv/read-csv stmt-str)] + (is (= ["id" "actor_mbox" "verb_id" "object_id"] + (first stmt-seq))) + (is (= [(get stmt-1 "id") + (get-in stmt-1 ["actor" "mbox"]) + (get-in stmt-1 ["verb" "id"]) + (get-in stmt-1 ["object" "id"])] + (first (rest stmt-seq)))) + (is (= [(get stmt-0 "id") + (get-in stmt-0 ["actor" "mbox"]) + (get-in stmt-0 ["verb" "id"]) + (get-in stmt-0 ["object" "id"])] + (first (rest (rest stmt-seq)))))))) (testing "CSV Seq - ascending set to true" - (let [stmt-seq (adp/-get-statements-csv lrs hdrs {:ascending true})] - (is (not (realized? stmt-seq))) - (is (= ["id" "actor_mbox" "verb_id" "object_id"] - (first stmt-seq))) - (is (= [(get stmt-0 "id") - (get-in stmt-0 ["actor" "mbox"]) - (get-in stmt-0 ["verb" "id"]) - (get-in stmt-0 ["object" "id"])] - (first (rest stmt-seq)))) - (is (= [(get stmt-1 "id") - (get-in stmt-1 ["actor" "mbox"]) - (get-in stmt-1 ["verb" "id"]) - (get-in stmt-1 ["object" "id"])] - (first (rest (rest stmt-seq))))))) + (with-open [writer (java.io.StringWriter.)] + (adp/-get-statements-csv lrs writer hdrs {:ascending true}) + (let [stmt-str (str writer) + stmt-seq (csv/read-csv stmt-str)] + (is (not (realized? stmt-seq))) + (is (= ["id" "actor_mbox" "verb_id" "object_id"] + (first stmt-seq))) + (is (= [(get stmt-0 "id") + (get-in stmt-0 ["actor" "mbox"]) + (get-in stmt-0 ["verb" "id"]) + (get-in stmt-0 ["object" "id"])] + (first (rest stmt-seq)))) + (is (= [(get stmt-1 "id") + (get-in stmt-1 ["actor" "mbox"]) + (get-in stmt-1 ["verb" "id"]) + (get-in stmt-1 ["object" "id"])] + (first (rest (rest stmt-seq)))))))) + (testing "CSV Seq - Entire database gets returned beyond `:limit`" + (let [statements (->> #(assoc stmt-0 "id" (str (squuid/generate-squuid))) + (repeatedly 100))] + (lrsp/-store-statements lrs auth-ident statements [])) + (with-open [writer (java.io.StringWriter.)] + (adp/-get-statements-csv lrs writer hdrs {}) + (let [stmt-str (str writer) + stmt-seq (csv/read-csv stmt-str)] + (is (= 103 (count stmt-seq)))))) (finally (component/stop sys'))))) ;; TODO: Add tests for creds with no explicit scopes, once From 131e2ef2fd9b60c7dea40ca24f2a26fa7613361b Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Fri, 14 Feb 2025 16:39:47 -0500 Subject: [PATCH 15/24] Delete now-unused requires --- src/main/lrsql/admin/interceptors/lrs_management.clj | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/main/lrsql/admin/interceptors/lrs_management.clj b/src/main/lrsql/admin/interceptors/lrs_management.clj index c879f6075..6560d0a4d 100644 --- a/src/main/lrsql/admin/interceptors/lrs_management.clj +++ b/src/main/lrsql/admin/interceptors/lrs_management.clj @@ -1,8 +1,6 @@ (ns lrsql.admin.interceptors.lrs-management (:require [clojure.spec.alpha :as s] - [clojure.data.csv :as csv] [clojure.edn :as edn] - [clojure.java.io :as io] [io.pedestal.interceptor :refer [interceptor]] [io.pedestal.interceptor.chain :as chain] [lrsql.admin.protocol :as adp] From ae0428210709db5f8f2595a2c4afb8b4729e8f70 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Fri, 14 Feb 2025 16:47:12 -0500 Subject: [PATCH 16/24] Add docstrings, specs, and refactors to query fn --- src/main/lrsql/admin/protocol.clj | 10 +++- src/main/lrsql/ops/query/statement.clj | 70 ++++++++++---------------- src/main/lrsql/system/lrs.clj | 2 +- 3 files changed, 35 insertions(+), 47 deletions(-) diff --git a/src/main/lrsql/admin/protocol.clj b/src/main/lrsql/admin/protocol.clj index ed7dbec05..1877d0007 100644 --- a/src/main/lrsql/admin/protocol.clj +++ b/src/main/lrsql/admin/protocol.clj @@ -43,5 +43,11 @@ "Soft-delete a reaction.")) (defprotocol AdminLRSManager - (-delete-actor [this params]) - (-get-statements-csv [this writer property-paths params])) + (-delete-actor [this params] + "Delete actor by `:actor-id`") + (-get-statements-csv [this writer property-paths params] + "Retrieve statements by CSV. Instead of returning a sequence of + statements, streams them to `writer` as a side effect, in order to + avoid storing them in memory. `property-paths` are defined in the + Reactions API, while `params` are the same query params for + `-get-statements`.")) diff --git a/src/main/lrsql/ops/query/statement.clj b/src/main/lrsql/ops/query/statement.clj index b8b151b41..033814a5c 100644 --- a/src/main/lrsql/ops/query/statement.clj +++ b/src/main/lrsql/ops/query/statement.clj @@ -1,6 +1,5 @@ (ns lrsql.ops.query.statement (:require [clojure.spec.alpha :as s] - [clojure.java.io :as io] [clojure.data.csv :as csv] [com.yetanalytics.lrs.protocol :as lrsp] [lrsql.backend.protocol :as bp] @@ -129,55 +128,38 @@ (query-one-statement bk tx input ltags) (query-many-statements bk tx input ltags prefix)))) -#_(s/fdef query-all-statements +(s/fdef query-statements-stream :args (s/cat :bk ss/statement-backend? :tx transaction? :input ss/statement-query-many-spec :ltags ss/lang-tags-spec - :property-paths vector?)) + :property-paths vector? + :writer #(instance? java.io.Writer %))) -(defn query-all-statements - "Query a lazy seq of all the statements in the database, filtered by `input`. - The `:limit` parameter will dictate the size of each query batch, but will - not limit the total number of statements streamed. Ignores attachments." - [bk tx input ltags property-paths writeable] - (let [format (:format input) - input (-> input - (dissoc :from :query-params) - (assoc :limit 1000000)) - json-paths (us/property-paths->json-paths property-paths) +(defn query-statements-stream + "Stream all the statements in the database, filtered by `input`, to `writer`. + The `:limit` parameter will be ignored. Attachments are not included." + [bk tx input ltags property-paths writer] + (let [format (:format input) + input (-> input ; TODO: Remove `:input` from query entirely. + (dissoc :from :query-params) + (assoc :limit 1000000)) + json-paths (us/property-paths->json-paths property-paths) csv-headers (us/property-paths->csv-headers property-paths)] - (with-open [writer (io/writer writeable)] - (csv/write-csv writer [csv-headers] :newline :cr+lf) - (transduce (comp (map (fn [res] - (query-res->statement format ltags res))) - (map (fn [stmt] - (us/statement->csv-row json-paths stmt)))) - (fn write-csv-reducer - ([writer] - writer) - ([writer row] - (csv/write-csv writer [row] :newline :cr+lf) - writer)) - writer - (bp/-query-statements-lazy bk tx input)) - #_(->> (bp/-query-statements-lazy bk tx input) - #_(map format-fn result) - (into []) - #_(us/statements->csv-seq property-paths) - #_(reduce (fn [writer row] - (csv/write-csv writer [row] :newline :cr+lf)) - writer)))) - #_(let [{:keys [statement-results ?next-cursor]} - (query-many-statements* bk tx input ltags)] - (if ?next-cursor - (let [next-str (u/uuid->str ?next-cursor) - new-input (-> input - (assoc :from ?next-cursor) - (assoc-in [:query-params :from] next-str))] - (concat statement-results - (lazy-seq (query-all-statements bk tx new-input ltags property-paths)))) - statement-results))) + (csv/write-csv writer [csv-headers] :newline :cr+lf) + (transduce (comp (map (fn [res] + (query-res->statement format ltags res))) + (map (fn [stmt] + (us/statement->csv-row json-paths stmt)))) + (fn write-csv-reducer + ([writer] + writer) + ([writer row] + (csv/write-csv writer [row] :newline :cr+lf) + writer)) + writer + (bp/-query-statements-lazy bk tx input)) + writer)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Statement Descendant Querying diff --git a/src/main/lrsql/system/lrs.clj b/src/main/lrsql/system/lrs.clj index ff1526d36..f14fa0ceb 100644 --- a/src/main/lrsql/system/lrs.clj +++ b/src/main/lrsql/system/lrs.clj @@ -404,7 +404,7 @@ input (-> params ; TODO: Higher limit for CSV stream? (stmt-util/ensure-default-max-limit config) (stmt-input/query-statement-input nil))] - (stmt-q/query-all-statements backend + (stmt-q/query-statements-stream backend conn input {} From d311b071914f6769e767598ddddf5c352535087b Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Mon, 17 Feb 2025 13:08:11 -0500 Subject: [PATCH 17/24] Add with-open clause to interceptor --- src/main/lrsql/admin/interceptors/lrs_management.clj | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/main/lrsql/admin/interceptors/lrs_management.clj b/src/main/lrsql/admin/interceptors/lrs_management.clj index 6560d0a4d..1c8094796 100644 --- a/src/main/lrsql/admin/interceptors/lrs_management.clj +++ b/src/main/lrsql/admin/interceptors/lrs_management.clj @@ -1,6 +1,7 @@ (ns lrsql.admin.interceptors.lrs-management (:require [clojure.spec.alpha :as s] [clojure.edn :as edn] + [clojure.java.io :as io] [io.pedestal.interceptor :refer [interceptor]] [io.pedestal.interceptor.chain :as chain] [lrsql.admin.protocol :as adp] @@ -90,7 +91,8 @@ {:status 200 :headers csv-response-header :body (fn [^ServletOutputStream os] - (adp/-get-statements-csv lrs - os - property-paths - query-params))})))})) + (with-open [writer (io/writer os)] + (adp/-get-statements-csv lrs + writer + property-paths + query-params)))})))})) From e766c2172dde93e69024c23d9e52847e3dd2837e Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Mon, 17 Feb 2025 15:42:20 -0500 Subject: [PATCH 18/24] Make :limit an optional param so it can be dissoc'd --- src/db/postgres/lrsql/postgres/sql/query.sql | 6 +++--- src/db/sqlite/lrsql/sqlite/sql/query.sql | 3 +-- src/main/lrsql/ops/query/statement.clj | 3 +-- 3 files changed, 5 insertions(+), 7 deletions(-) diff --git a/src/db/postgres/lrsql/postgres/sql/query.sql b/src/db/postgres/lrsql/postgres/sql/query.sql index f1b8f6a71..23352b7b7 100644 --- a/src/db/postgres/lrsql/postgres/sql/query.sql +++ b/src/db/postgres/lrsql/postgres/sql/query.sql @@ -67,7 +67,7 @@ WHERE stmt.is_voided = FALSE --~ (when (:registration params) "AND stmt.registration = :registration") --~ (when (:authority-ifis params) "AND :frag:postgres-auth-subquery") --~ (if (:ascending? params) "ORDER BY stmt.id ASC" "ORDER BY stmt.id DESC") -LIMIT :limit +--~ (when (:limit params) "LIMIT :limit") /* Note: We sort by both the PK and statement ID in order to force the query planner to avoid scanning on `stmt_a.id` first, which is much slower than @@ -92,7 +92,7 @@ WHERE stmt_a.is_voided = FALSE --~ (when (:authority-ifis params) "AND :frag:postgres-auth-subquery") /*~ (if (:ascending? params) "ORDER BY (stmt_a.id, stmt_a.statement_id) ASC" "ORDER BY (stmt_a.id, stmt_a.statement_id) DESC") ~*/ -LIMIT :limit +--~ (when (:limit params) "LIMIT :limit") -- :name query-statements -- :command :query @@ -107,7 +107,7 @@ FROM ( (:frag:postgres-stmt-ref-subquery-frag)) AS all_stmt --~ (if (:ascending? params) "ORDER BY all_stmt.id ASC" "ORDER BY all_stmt.id DESC") -LIMIT :limit; +--~ (when (:limit params) "LIMIT :limit"); /* Statement Object Queries */ diff --git a/src/db/sqlite/lrsql/sqlite/sql/query.sql b/src/db/sqlite/lrsql/sqlite/sql/query.sql index de0e22b3a..dc1ec904b 100644 --- a/src/db/sqlite/lrsql/sqlite/sql/query.sql +++ b/src/db/sqlite/lrsql/sqlite/sql/query.sql @@ -89,8 +89,7 @@ TRUE --~ (when (:authority-ifis params) "AND :frag:sqlite-auth-ref-subquery") )) --~ (if (:ascending? params) "ORDER BY stmt.id ASC" "ORDER BY stmt.id DESC") -LIMIT :limit - +--~ (when (:limit params) "LIMIT :limit") /* Statement Object Queries */ diff --git a/src/main/lrsql/ops/query/statement.clj b/src/main/lrsql/ops/query/statement.clj index 033814a5c..c115844c0 100644 --- a/src/main/lrsql/ops/query/statement.clj +++ b/src/main/lrsql/ops/query/statement.clj @@ -142,8 +142,7 @@ [bk tx input ltags property-paths writer] (let [format (:format input) input (-> input ; TODO: Remove `:input` from query entirely. - (dissoc :from :query-params) - (assoc :limit 1000000)) + (dissoc :from :limit :query-params)) json-paths (us/property-paths->json-paths property-paths) csv-headers (us/property-paths->csv-headers property-paths)] (csv/write-csv writer [csv-headers] :newline :cr+lf) From 8ea1204ee9a458d7ddd2a2b8e8c2552828493a4c Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Mon, 17 Feb 2025 16:46:20 -0500 Subject: [PATCH 19/24] Remove stray semicolon from PG query --- src/db/postgres/lrsql/postgres/sql/query.sql | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/db/postgres/lrsql/postgres/sql/query.sql b/src/db/postgres/lrsql/postgres/sql/query.sql index 23352b7b7..955500c3f 100644 --- a/src/db/postgres/lrsql/postgres/sql/query.sql +++ b/src/db/postgres/lrsql/postgres/sql/query.sql @@ -67,7 +67,7 @@ WHERE stmt.is_voided = FALSE --~ (when (:registration params) "AND stmt.registration = :registration") --~ (when (:authority-ifis params) "AND :frag:postgres-auth-subquery") --~ (if (:ascending? params) "ORDER BY stmt.id ASC" "ORDER BY stmt.id DESC") ---~ (when (:limit params) "LIMIT :limit") +--~ (when (:limit params) "LIMIT :limit") /* Note: We sort by both the PK and statement ID in order to force the query planner to avoid scanning on `stmt_a.id` first, which is much slower than @@ -107,7 +107,7 @@ FROM ( (:frag:postgres-stmt-ref-subquery-frag)) AS all_stmt --~ (if (:ascending? params) "ORDER BY all_stmt.id ASC" "ORDER BY all_stmt.id DESC") ---~ (when (:limit params) "LIMIT :limit"); +--~ (when (:limit params) "LIMIT :limit") /* Statement Object Queries */ From 27bb8119b91998d428936a9963ffa01a46f78baf Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Mon, 17 Feb 2025 16:46:50 -0500 Subject: [PATCH 20/24] Reinstate transaction in get-statements-csv --- src/main/lrsql/system/lrs.clj | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/main/lrsql/system/lrs.clj b/src/main/lrsql/system/lrs.clj index f14fa0ceb..205a590ff 100644 --- a/src/main/lrsql/system/lrs.clj +++ b/src/main/lrsql/system/lrs.clj @@ -404,11 +404,10 @@ input (-> params ; TODO: Higher limit for CSV stream? (stmt-util/ensure-default-max-limit config) (stmt-input/query-statement-input nil))] - (stmt-q/query-statements-stream backend - conn - input - {} - property-paths - output-stream) - #_(jdbc/with-transaction [tx conn] - (stmt-q/query-all-statements backend tx input {} property-paths))))) + (jdbc/with-transaction [tx conn] + (stmt-q/query-statements-stream backend + tx + input + {} + property-paths + output-stream))))) From 379933a605d39c7baf0bce4fdef2a2010d9efd40 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 18 Feb 2025 10:02:05 -0500 Subject: [PATCH 21/24] Extract bench inputs to support namespace --- src/test/lrsql/concurrency_test.clj | 27 +++------------------------ src/test/lrsql/lrs_test.clj | 7 +------ src/test/lrsql/test_support.clj | 24 ++++++++++++++++++++++++ 3 files changed, 28 insertions(+), 30 deletions(-) diff --git a/src/test/lrsql/concurrency_test.clj b/src/test/lrsql/concurrency_test.clj index 6f2783ff0..b448e672e 100644 --- a/src/test/lrsql/concurrency_test.clj +++ b/src/test/lrsql/concurrency_test.clj @@ -4,8 +4,6 @@ [clojure.core.async :as a] [com.stuartsierra.component :as component] [babashka.curl :as curl] - [com.yetanalytics.datasim.input :as sim-input] - [com.yetanalytics.datasim.sim :as sim] [xapi-schema.spec :as xs] [lrsql.test-support :as support] [lrsql.util :as u])) @@ -18,25 +16,6 @@ (use-fixtures :each support/fresh-db-fixture) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Helpers -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; We reuse bench inputs for tests here. - -(defn test-statements - [num-stmts] - (->> "dev-resources/bench/insert_input.json" - (sim-input/from-location :input :json) - sim/sim-seq - (take num-stmts) - (into []))) - -(def test-queries - (-> "dev-resources/bench/query_input.json" - slurp - (u/parse-json :object? false))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tests ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -71,7 +50,7 @@ num-threads 5 query-mult 5] (testing "concurrent insertions" - (let [insert-reqs (->> (test-statements num-stmts) + (let [insert-reqs (->> (support/bench-statements num-stmts) (partition batch-size) (map (fn [batch] {:headers headers @@ -104,7 +83,7 @@ false)) insert-res)))) (testing "concurrent queries" - (let [query-reqs (->> test-queries + (let [query-reqs (->> support/bench-queries (mapcat (partial repeat query-mult)) (map (fn [query] {:headers headers @@ -114,7 +93,7 @@ endpoint query-reqs num-threads)] - (is (= (* query-mult (count test-queries)) + (is (= (* query-mult (count support/bench-queries)) (count query-res))) (is (every? (fn [res] (cond ;; Queries should never deadlock diff --git a/src/test/lrsql/lrs_test.clj b/src/test/lrsql/lrs_test.clj index 0df021a62..c2e65e6fc 100644 --- a/src/test/lrsql/lrs_test.clj +++ b/src/test/lrsql/lrs_test.clj @@ -2,7 +2,6 @@ (:require [clojure.test :refer [deftest testing is use-fixtures]] [clojure.string :as cstr] [com.stuartsierra.component :as component] - [com.yetanalytics.datasim :as ds] [com.yetanalytics.lrs.protocol :as lrsp] [lrsql.admin.protocol :as adp] [lrsql.test-support :as support] @@ -930,11 +929,7 @@ ;; We reuse bench resources for tests here. (def test-statements - (->> "dev-resources/bench/insert_input.json" - ds/read-input - ds/generate-seq - (take 50) - (into []))) + (support/bench-statements 50)) (deftest datasim-tests (let [sys (support/test-system) diff --git a/src/test/lrsql/test_support.clj b/src/test/lrsql/test_support.clj index 44e4b24c4..6180d8d1f 100644 --- a/src/test/lrsql/test_support.clj +++ b/src/test/lrsql/test_support.clj @@ -3,6 +3,7 @@ [clojure.string :as cstr] [orchestra.spec.test :as otest] [next.jdbc.connection :refer [jdbc-url]] + [com.yetanalytics.datasim :as ds] [lrsql.init.config :refer [read-config]] [lrsql.system :as system] [lrsql.sqlite.record :as sr] @@ -167,3 +168,26 @@ %)) code) tests)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Bench Inputs +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; We can reuse bench inputs for tests + +(defn bench-statements* + [num-statements] + (->> "dev-resources/bench/insert_input.json" + ds/read-input + ds/generate-seq + (take num-statements))) + +(defn bench-statements + [num-statements] + (->> (bench-statements* num-statements) + (into []))) + +(def bench-queries + (-> "dev-resources/bench/query_input.json" + slurp + (u/parse-json :object? false))) From 0bb71918f01e9aafd4a3a88c9c0eb01011e4afb7 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 18 Feb 2025 11:50:53 -0500 Subject: [PATCH 22/24] Add tests for inserting and querying large amounts of data --- src/test/logback-test.xml | 2 + src/test/lrsql/bench_test.clj | 107 ++++++++++++++++++++++++++++ src/test/lrsql/concurrency_test.clj | 12 ++-- 3 files changed, 117 insertions(+), 4 deletions(-) create mode 100644 src/test/lrsql/bench_test.clj diff --git a/src/test/logback-test.xml b/src/test/logback-test.xml index e615ec762..e9f112687 100644 --- a/src/test/logback-test.xml +++ b/src/test/logback-test.xml @@ -10,4 +10,6 @@ + + diff --git a/src/test/lrsql/bench_test.clj b/src/test/lrsql/bench_test.clj new file mode 100644 index 000000000..99296c3f8 --- /dev/null +++ b/src/test/lrsql/bench_test.clj @@ -0,0 +1,107 @@ +(ns lrsql.bench-test + "Testing for inserting and downloading large amounts of statements." + (:require [clojure.test :refer [deftest testing is use-fixtures]] + [clojure.data.csv :as csv] + [clojure.java.io :as io] + [clojure.tools.logging :as log] + [ring.util.codec :refer [url-encode]] + [com.stuartsierra.component :as component] + [babashka.curl :as curl] + [java-time.api :as jt] + [lrsql.util :as u] + [lrsql.test-support :as support])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Init +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(support/instrument-lrsql) + +(use-fixtures :each support/fresh-db-fixture) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Increase or decrease as needed +(def num-statements 5000) + +(def batch-size 50) + +(def headers + {"Content-Type" "application/json" + "X-Experience-API-Version" "1.0.3"}) + +(def basic-auth + ["username" "password"]) + +(deftest bench-test + (let [sys (support/test-system) + sys' (component/start sys) + url-prefix (-> sys' :webserver :config :url-prefix) + stmt-endpoint (format "http://localhost:8080%s/statements" url-prefix) + csv-endpoint (format "http://localhost:8080/admin/csv?property-paths=%s" + (url-encode [["id"] ["verb" "id"]])) + statements (support/bench-statements* num-statements)] + (testing "Inserting large amounts of data" + (let [start (jt/instant)] + (loop [batches (partition-all batch-size statements) + fail? false] + (if-some [batch (first batches)] + (let [{:keys [status]} + (try (curl/post stmt-endpoint + {:headers headers + :basic-auth basic-auth + :body (u/write-json-str (vec batch))}) + (catch Exception e e))] + (recur (rest batches) + (or fail? (not= 200 status)))) + (let [end (jt/instant) + t-diff (jt/time-between start end :seconds)] + (log/infof "Inserted %d statements in %s seconds" + num-statements + t-diff) + (is (not fail?))))))) + (testing "Querying large amounts of data" + (let [start (jt/instant)] + (loop [query-url stmt-endpoint + stmt-count 0 + fail? false] + (let [{:keys [status body]} + (try (curl/get query-url + {:headers headers + :basic-auth basic-auth}) + (catch Exception e e)) + {:keys [statements more]} + (some-> body (u/parse-json :keyword-keys? true)) + query-url* + (str "http://localhost:8080" more) + stmt-count* + (+ stmt-count (count statements))] + (if (and (= 200 status) + (not-empty more)) + (recur query-url* + stmt-count* + (or fail? (not= 200 status))) + (let [end (jt/instant) + t-diff (jt/time-between start end :seconds)] + (log/infof "Queried %d statements in %s seconds" + num-statements + t-diff) + (is (not fail?)) + (is (= num-statements stmt-count*)))))))) + (testing "Downloading large amounts of data" + (let [start + (jt/instant) + {:keys [status] input-stream :body} + (curl/get csv-endpoint {:as :stream})] + (with-open [reader (io/reader input-stream)] + (let [res-count (count (csv/read-csv reader)) + end (jt/instant) + t-diff (jt/time-between start end :seconds)] + (log/infof "Downloaded CSV of %d statements in %s seconds" + num-statements + t-diff) + (is (= 200 status)) + (is (= (inc num-statements) res-count)))))) + (component/stop sys'))) diff --git a/src/test/lrsql/concurrency_test.clj b/src/test/lrsql/concurrency_test.clj index b448e672e..a2b93535d 100644 --- a/src/test/lrsql/concurrency_test.clj +++ b/src/test/lrsql/concurrency_test.clj @@ -1,4 +1,5 @@ (ns lrsql.concurrency-test + "Tests for concurrent insertions and queries." (:require [clojure.test :refer [deftest testing is use-fixtures]] [clojure.spec.alpha :as s] [clojure.core.async :as a] @@ -35,14 +36,17 @@ req-chan) (a/ sys' :webserver :config :url-prefix) - ;; Curl - headers {"Content-Type" "application/json" - "X-Experience-API-Version" "1.0.3"} - basic-auth ["username" "password"] ;; Parameters endpoint (format "http://localhost:8080%s/statements" url-prefix) num-stmts 100 From 83e7504ba056f365cbe2ca50ed162a557a92f9e2 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 18 Feb 2025 11:57:52 -0500 Subject: [PATCH 23/24] Move encoding functions to util namespace --- src/main/lrsql/system/util.clj | 2 +- src/main/lrsql/util.clj | 23 +++++++++++++++++++++++ src/main/lrsql/util/statement.clj | 5 ++--- src/test/lrsql/admin/route_test.clj | 5 ++--- src/test/lrsql/bench_test.clj | 3 +-- src/test/lrsql/scope_test.clj | 3 +-- 6 files changed, 30 insertions(+), 11 deletions(-) diff --git a/src/main/lrsql/system/util.clj b/src/main/lrsql/system/util.clj index 2cfb5d019..7ae0f00ce 100644 --- a/src/main/lrsql/system/util.clj +++ b/src/main/lrsql/system/util.clj @@ -4,7 +4,7 @@ [clojure.walk :as w] [clojure.tools.logging :as log] [next.jdbc.connection :as jdbc-conn] - [ring.util.codec :refer [form-encode form-decode]])) + [lrsql.util :refer [form-encode form-decode]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Helpers and Macros diff --git a/src/main/lrsql/util.clj b/src/main/lrsql/util.clj index b3e27aa7e..792432cbb 100644 --- a/src/main/lrsql/util.clj +++ b/src/main/lrsql/util.clj @@ -6,6 +6,7 @@ [clojure.tools.logging :as log] [clojure.java.io :as io] [cheshire.core :as cjson] + [ring.util.codec :as ring-codec] [xapi-schema.spec :as xs] [com.yetanalytics.squuid :as squuid] [com.yetanalytics.lrs.xapi.document :refer [json-bytes-gen-fn]] @@ -361,3 +362,25 @@ (io/copy in baos) (.flush baos) (.toByteArray baos))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Form + URL Encoding +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Wrappers for ring.util.codec functions so that we don't have to remember +;; that particular util namespace. + +(defn form-encode + "Wrapper for `ring.util.codec/form-encode`." + [s] + (ring-codec/form-encode s)) + +(defn form-decode + "Wrapper for `ring.util.codec/form-decode`." + [s] + (ring-codec/form-decode s)) + +(defn url-encode + "Wrapper for `ring.util.codec/url-encode`." + [s] + (ring-codec/url-encode s)) diff --git a/src/main/lrsql/util/statement.clj b/src/main/lrsql/util/statement.clj index c21acf77f..c4156c7cc 100644 --- a/src/main/lrsql/util/statement.clj +++ b/src/main/lrsql/util/statement.clj @@ -1,6 +1,5 @@ (ns lrsql.util.statement - (:require [ring.util.codec :refer [form-encode]] - [com.yetanalytics.pathetic :as pa] + (:require [com.yetanalytics.pathetic :as pa] [com.yetanalytics.lrs.xapi.statements :as ss] [lrsql.util :as u] [lrsql.util.path :as up])) @@ -166,7 +165,7 @@ (let [{?agent :agent} query-params] (str prefix "/statements?" - (form-encode + (u/form-encode (cond-> query-params true (assoc :from (u/uuid->str next-cursor)) ?agent (assoc :agent (u/write-json-str ?agent))))))) diff --git a/src/test/lrsql/admin/route_test.clj b/src/test/lrsql/admin/route_test.clj index cec7af601..8c777f221 100644 --- a/src/test/lrsql/admin/route_test.clj +++ b/src/test/lrsql/admin/route_test.clj @@ -4,7 +4,6 @@ (:require [clojure.test :refer [deftest testing is use-fixtures are]] [clojure.string :refer [lower-case]] [babashka.curl :as curl] - [ring.util.codec :refer [url-encode]] [com.stuartsierra.component :as component] [xapi-schema.spec.regex :refer [Base64RegEx]] [com.yetanalytics.lrs.protocol :as lrsp] @@ -287,7 +286,7 @@ (= 200)))))) (testing "download CSV data" (let [property-paths-vec [["id"] ["actor" "mbox"]] - property-paths-str (url-encode (str property-paths-vec)) + property-paths-str (u/url-encode (str property-paths-vec)) endpoint-url (format "http://0.0.0.0:8080/admin/csv?property-paths=%s&ascending=true" property-paths-str) {:keys [status body]} (curl/get endpoint-url @@ -296,7 +295,7 @@ csv-body (slurp body)] (is (= 200 status)) (is (= "id,actor_mbox\r\n" csv-body))) - (let [bad-prop-path (->> ["zoo" "wee" "mama"] str url-encode) + (let [bad-prop-path (->> ["zoo" "wee" "mama"] str u/url-encode) bad-url (format "http://0.0.0.0:8080/admin/csv?property-paths=%s" bad-prop-path)] (is-err-code (curl/get bad-url {:headers headers :as :stream}) diff --git a/src/test/lrsql/bench_test.clj b/src/test/lrsql/bench_test.clj index 99296c3f8..44290b9b5 100644 --- a/src/test/lrsql/bench_test.clj +++ b/src/test/lrsql/bench_test.clj @@ -4,7 +4,6 @@ [clojure.data.csv :as csv] [clojure.java.io :as io] [clojure.tools.logging :as log] - [ring.util.codec :refer [url-encode]] [com.stuartsierra.component :as component] [babashka.curl :as curl] [java-time.api :as jt] @@ -41,7 +40,7 @@ url-prefix (-> sys' :webserver :config :url-prefix) stmt-endpoint (format "http://localhost:8080%s/statements" url-prefix) csv-endpoint (format "http://localhost:8080/admin/csv?property-paths=%s" - (url-encode [["id"] ["verb" "id"]])) + (u/url-encode [["id"] ["verb" "id"]])) statements (support/bench-statements* num-statements)] (testing "Inserting large amounts of data" (let [start (jt/instant)] diff --git a/src/test/lrsql/scope_test.clj b/src/test/lrsql/scope_test.clj index 3b40f5060..fee06df33 100644 --- a/src/test/lrsql/scope_test.clj +++ b/src/test/lrsql/scope_test.clj @@ -5,7 +5,6 @@ (:require [clojure.test :refer [deftest testing is use-fixtures]] [clojure.string :as cstr] [babashka.curl :as curl] - [ring.util.codec :refer [form-encode]] [com.stuartsierra.component :as component] [lrsql.test-support :as support] [lrsql.util :as u]) @@ -159,7 +158,7 @@ (let [params-vec (reduce-kv (fn [acc k v] (let [k-str (name k) - v-str (form-encode v)] + v-str (u/form-encode v)] (conj acc (str k-str "=" v-str)))) [] params) From ce400e19c2283304ff0eefb7be8089a9561c8a09 Mon Sep 17 00:00:00 2001 From: kelvinqian00 Date: Tue, 18 Feb 2025 12:15:27 -0500 Subject: [PATCH 24/24] Refactor query-statements-stream a bit --- src/main/lrsql/ops/query/statement.clj | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/main/lrsql/ops/query/statement.clj b/src/main/lrsql/ops/query/statement.clj index c115844c0..b285d9fb8 100644 --- a/src/main/lrsql/ops/query/statement.clj +++ b/src/main/lrsql/ops/query/statement.clj @@ -137,12 +137,12 @@ :writer #(instance? java.io.Writer %))) (defn query-statements-stream - "Stream all the statements in the database, filtered by `input`, to `writer`. - The `:limit` parameter will be ignored. Attachments are not included." + "Stream all the statements in the database, filtered by `input`, to `writer` + as CSV data. The `:limit` parameter will be ignored. Attachments are not + included." [bk tx input ltags property-paths writer] (let [format (:format input) - input (-> input ; TODO: Remove `:input` from query entirely. - (dissoc :from :limit :query-params)) + input (dissoc input :from :limit :query-params) json-paths (us/property-paths->json-paths property-paths) csv-headers (us/property-paths->csv-headers property-paths)] (csv/write-csv writer [csv-headers] :newline :cr+lf)