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
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/postgres/lrsql/postgres/sql/query.sql b/src/db/postgres/lrsql/postgres/sql/query.sql
index f1b8f6a71..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")
-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/record.clj b/src/db/sqlite/lrsql/sqlite/record.clj
index 515368559..fbd4e3cf0 100644
--- a/src/db/sqlite/lrsql/sqlite/record.clj
+++ b/src/db/sqlite/lrsql/sqlite/record.clj
@@ -2,11 +2,12 @@
(: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!]]
[lrsql.sqlite.data :as sd]
- [lrsql.util.reaction :as ru])
+ [lrsql.util.path :refer [path->sqlpath-string]])
(:import [org.sqlite SQLiteException SQLiteErrorCode]))
;; Init HugSql functions
@@ -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))
@@ -313,7 +318,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->sqlpath-string)))
(-snip-val [_ params]
(snip-val params))
(-snip-col [_ params]
@@ -327,7 +332,7 @@
(-snip-not [_ params]
(snip-not params))
(-snip-contains [_ params]
- (snip-contains (update params :path ru/path->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/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/admin/interceptors/lrs_management.clj b/src/main/lrsql/admin/interceptors/lrs_management.clj
index 76f326ebb..1c8094796 100644
--- a/src/main/lrsql/admin/interceptors/lrs_management.clj
+++ b/src/main/lrsql/admin/interceptors/lrs_management.clj
@@ -1,9 +1,18 @@
(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]
- [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 +40,59 @@
(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"})
+
+(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]
+ (assoc ctx
+ :response
+ {:status 200
+ :headers csv-response-header
+ :body (fn [^ServletOutputStream os]
+ (with-open [writer (io/writer os)]
+ (adp/-get-statements-csv lrs
+ writer
+ property-paths
+ query-params)))})))}))
diff --git a/src/main/lrsql/admin/protocol.clj b/src/main/lrsql/admin/protocol.clj
index 4dbf6766a..1877d0007 100644
--- a/src/main/lrsql/admin/protocol.clj
+++ b/src/main/lrsql/admin/protocol.clj
@@ -43,4 +43,11 @@
"Soft-delete a reaction."))
(defprotocol AdminLRSManager
- (-delete-actor [this 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/admin/routes.clj b/src/main/lrsql/admin/routes.clj
index 170d9022e..7ac99851f 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/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 0189a7165..b285d9fb8 100644
--- a/src/main/lrsql/ops/query/statement.clj
+++ b/src/main/lrsql/ops/query/statement.clj
@@ -1,5 +1,6 @@
(ns lrsql.ops.query.statement
(:require [clojure.spec.alpha :as s]
+ [clojure.data.csv :as csv]
[com.yetanalytics.lrs.protocol :as lrsp]
[lrsql.backend.protocol :as bp]
[lrsql.spec.common :refer [transaction?]]
@@ -40,53 +41,70 @@
: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))))
+(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* (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))
+ query-results* (if (some? ?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}))
+
(defn- query-many-statements
"Query potentially multiple statements from the DB."
[bk tx input ltags prefix]
- (let [{:keys [format limit attachments? query-params]} 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))
- 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)))
- [])]
+ (let [{:keys [attachments? query-params]}
+ input
+ {:keys [statement-results ?next-cursor]}
+ (query-many-statements* bk tx input ltags)
+ attachment-results
+ (if attachments?
+ (vec (doall (->> (mapcat
+ (partial query-statement-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?
@@ -110,6 +128,38 @@
(query-one-statement bk tx input ltags)
(query-many-statements bk tx input ltags prefix))))
+(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?
+ :writer #(instance? java.io.Writer %)))
+
+(defn query-statements-stream
+ "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 (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)
+ (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 e5851824f..205a590ff 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,20 @@
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 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))]
+ (jdbc/with-transaction [tx conn]
+ (stmt-q/query-statements-stream backend
+ tx
+ input
+ {}
+ property-paths
+ output-stream)))))
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/path.clj b/src/main/lrsql/util/path.clj
new file mode 100644
index 000000000..22c909eea
--- /dev/null
+++ b/src/main/lrsql/util/path.clj
@@ -0,0 +1,63 @@
+(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]))
+
+(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->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->sqlpath-string path "$"))
+ ([[seg & rpath] s]
+ (if seg
+ (recur rpath
+ (cond
+ (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)
+ (format "%s[%d]" s seg)
+
+ :else
+ (throw (ex-info "Invalid path segement"
+ {:type ::invalid-path-segment
+ :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?)
+
+(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/main/lrsql/util/statement.clj b/src/main/lrsql/util/statement.clj
index 734398e0c..c4156c7cc 100644
--- a/src/main/lrsql/util/statement.clj
+++ b/src/main/lrsql/util/statement.clj
@@ -1,7 +1,8 @@
(ns lrsql.util.statement
- (:require [ring.util.codec :refer [form-encode]]
+ (:require [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
@@ -164,7 +165,40 @@
(let [{?agent :agent} query-params]
(str prefix
"/statements?"
- (form-encode
+ (u/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)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Statement CSV
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private json-path-opts
+ {:return-missing? true
+ :return-duplicates? false})
+
+(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))
+
+(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/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/admin/protocol_test.clj b/src/test/lrsql/admin/protocol_test.clj
index 6ed1bab84..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]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -263,6 +265,59 @@
(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"
+ (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"
+ (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
;; `statements/read/mine` is implemented
diff --git a/src/test/lrsql/admin/route_test.clj b/src/test/lrsql/admin/route_test.clj
index 8ec278a5b..8c777f221 100644
--- a/src/test/lrsql/admin/route_test.clj
+++ b/src/test/lrsql/admin/route_test.clj
@@ -284,6 +284,22 @@
"new-password" orig-pass})
:status
(= 200))))))
+ (testing "download CSV data"
+ (let [property-paths-vec [["id"] ["actor" "mbox"]]
+ 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
+ {: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 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})
+ 400)))
(testing "delete the `myname` account using the seed account"
(let [del-jwt (-> (login-account content-type req-body)
:body
diff --git a/src/test/lrsql/bench_test.clj b/src/test/lrsql/bench_test.clj
new file mode 100644
index 000000000..44290b9b5
--- /dev/null
+++ b/src/test/lrsql/bench_test.clj
@@ -0,0 +1,106 @@
+(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]
+ [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"
+ (u/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 6f2783ff0..a2b93535d 100644
--- a/src/test/lrsql/concurrency_test.clj
+++ b/src/test/lrsql/concurrency_test.clj
@@ -1,11 +1,10 @@
(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]
[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 +17,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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -56,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
@@ -71,7 +54,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 +87,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 +97,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/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)
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)))
diff --git a/src/test/lrsql/util/path_test.clj b/src/test/lrsql/util/path_test.clj
new file mode 100644
index 000000000..184fb0ee0
--- /dev/null
+++ b/src/test/lrsql/util/path_test.clj
@@ -0,0 +1,58 @@
+(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->sqlpath-string-test
+ (testing "Property path to JSONPath-like string for SQL"
+ (are [input output]
+ (= (p/path->sqlpath-string input)
+ 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->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]
+ (= (p/path->csv-header input)
+ 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")))
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"}
diff --git a/src/test/lrsql/util/statement_test.clj b/src/test/lrsql/util/statement_test.clj
index f15e34e52..7c118cfa3 100644
--- a/src/test/lrsql/util/statement_test.clj
+++ b/src/test/lrsql/util/statement_test.clj
@@ -4,7 +4,7 @@
[lrsql.util :as u]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Fixtures
+;; Test Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def sample-id
@@ -55,86 +55,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 +266,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)))))