[SQL-281] CSV export

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

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]

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 */
 

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]

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 */
 

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)))})))}))

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`."))

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,

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]))