diff --git a/.nvd/suppression.xml b/.nvd/suppression.xml
index 04d0fb9a3..da8098cc7 100644
--- a/.nvd/suppression.xml
+++ b/.nvd/suppression.xml
@@ -17,4 +17,13 @@
cpe:/a:postgresql:postgresql_jdbc_driver
CVE-2020-21469
+
+
+
+ ^pkg:maven/org\.eclipse\.jetty/jetty\-http@.*$
+ CVE-2023-40167
+
diff --git a/doc/endpoints.md b/doc/endpoints.md
index dd178a8ac..b7d566101 100644
--- a/doc/endpoints.md
+++ b/doc/endpoints.md
@@ -34,6 +34,7 @@ The following examples use `http://example.org` as the URL body. All methods ret
#### Misc Admin Routes
- `GET http://example.org/admin/env`: Get select environment variables about the configuration which may aid in client-side operations. Currently returns a map containing the configuration variables `urlPrefix` and `enableStmtHtml`.
+- `DELETE http://example.org/admin/agents`: Runs a *hard delete* of all records of an actor, and associated records (statements, attachments, etc). Intended for privacy purposes like GDPR. Body should be a JSON object of form `{"actor-ifi":}`. Disabled unless the configuration variable enableAdminDeleteActor to be set to `true`.
### Reaction Management Routes
diff --git a/doc/env_vars.md b/doc/env_vars.md
index 82bcfd258..ce599b09a 100644
--- a/doc/env_vars.md
+++ b/doc/env_vars.md
@@ -182,6 +182,7 @@ These config vars enable and configure browser security response headers from th
| Env Var | Config | Description | Default |
| --------------------------------- | ------------------------ | ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ | ------------------------------------------------------------------------------------------ |
+| `LRSQL_ENABLE_ADMIN_DELETE_ACTOR` | `enableAdminDeleteActor` | Whether or not to enable the route and UI for deleting actors and related documents | `false` |
| `LRSQL_ENABLE_ADMIN_UI` | `enableAdminUi` | Whether or not to serve the administrative UI at `/admin` | `true` |
| `LRSQL_ENABLE_ADMIN_STATUS` | `enableAdminStatus` | Whether or not to serve admin system status data that queries the database. | `true` |
| `LRSQL_ENABLE_STMT_HTML` | `enableStmtHtml` | Whether or not HTML data is returned in the LRS HTTP response. If `false` disables HTML rendering even if `LRSQL_ENABLE_ADMIN_UI` is `true`. In that case the UI will not display the Statement Browser feature. | `true` |
diff --git a/resources/lrsql/config/prod/default/webserver.edn b/resources/lrsql/config/prod/default/webserver.edn
index 6077ec936..476647c09 100644
--- a/resources/lrsql/config/prod/default/webserver.edn
+++ b/resources/lrsql/config/prod/default/webserver.edn
@@ -26,6 +26,7 @@
:allowed-origins #array #or [#env LRSQL_ALLOWED_ORIGINS nil]
:ssl-port #long #or [#env LRSQL_SSL_PORT 8443]
:url-prefix #or [#env LRSQL_URL_PREFIX "/xapi"]
+ :enable-admin-delete-actor #boolean #or [#env LRSQL_ENABLE_ADMIN_DELETE_ACTOR false]
:enable-admin-ui #boolean #or [#env LRSQL_ENABLE_ADMIN_UI true]
:enable-admin-status #boolean #or [#env LRSQL_ENABLE_ADMIN_STATUS true]
:enable-stmt-html #boolean #or [#env LRSQL_ENABLE_STMT_HTML true]
diff --git a/resources/lrsql/config/test/default/webserver.edn b/resources/lrsql/config/test/default/webserver.edn
index c8b0bf208..b4e66109d 100644
--- a/resources/lrsql/config/test/default/webserver.edn
+++ b/resources/lrsql/config/test/default/webserver.edn
@@ -19,6 +19,7 @@
;; Allow access from admin-ui dev
"http://localhost:9500"]
:url-prefix "/xapi"
+ :enable-admin-delete-actor true
:enable-admin-ui true
:enable-admin-status true
:enable-stmt-html true
diff --git a/src/db/postgres/lrsql/postgres/record.clj b/src/db/postgres/lrsql/postgres/record.clj
index 371d5c2be..4fae1035b 100644
--- a/src/db/postgres/lrsql/postgres/record.clj
+++ b/src/db/postgres/lrsql/postgres/record.clj
@@ -71,7 +71,9 @@
(xapi-statement-add-trigger-id! tx))
(if (-> tuning :config :enable-jsonb)
(migrate-to-jsonb! tx)
- (migrate-to-json! tx)))
+ (migrate-to-json! tx))
+ (when (nil? (check-statement-to-actor-cascading-delete tx))
+ (add-statement-to-actor-cascading-delete! tx)))
bp/BackendUtil
(-txn-retry? [_ ex]
@@ -105,6 +107,8 @@
(insert-statement-to-actor! tx input))
(-update-actor! [_ tx input]
(update-actor! tx input))
+ (-delete-actor! [_ tx input]
+ (delete-actor-and-dependents! tx input))
(-query-actor [_ tx input]
(query-actor tx input))
diff --git a/src/db/postgres/lrsql/postgres/sql/ddl.sql b/src/db/postgres/lrsql/postgres/sql/ddl.sql
index fe40f2e90..260756408 100644
--- a/src/db/postgres/lrsql/postgres/sql/ddl.sql
+++ b/src/db/postgres/lrsql/postgres/sql/ddl.sql
@@ -399,3 +399,17 @@ SELECT 1 FROM information_schema.columns WHERE table_name = 'xapi_statement' AND
ALTER TABLE xapi_statement ADD COLUMN trigger_id UUID;
ALTER TABLE xapi_statement ADD CONSTRAINT stmt_trigger_id_fk FOREIGN KEY (trigger_id) REFERENCES xapi_statement(statement_id);
CREATE INDEX IF NOT EXISTS stmt_trigger_id_idx ON xapi_statement(trigger_id);
+
+-- :name check-statement-to-actor-cascading-delete
+-- :result :one
+-- :command :execute
+SELECT 1
+FROM pg_constraint
+WHERE conname = 'statement_fk'
+AND pg_get_constraintdef(oid) LIKE '%ON DELETE CASCADE%'
+
+-- :name add-statement-to-actor-cascading-delete!
+-- :command :execute
+-- :doc Adds a cascading delete to delete st2actor entries when corresponding statements are deleted
+ALTER TABLE statement_to_actor DROP CONSTRAINT statement_fk;
+ALTER TABLE statement_to_actor ADD CONSTRAINT statement_fk FOREIGN KEY (statement_id) REFERENCES xapi_statement(statement_id) ON DELETE CASCADE;
diff --git a/src/db/postgres/lrsql/postgres/sql/delete.sql b/src/db/postgres/lrsql/postgres/sql/delete.sql
index 0e2e72a42..e0ff8a8b7 100644
--- a/src/db/postgres/lrsql/postgres/sql/delete.sql
+++ b/src/db/postgres/lrsql/postgres/sql/delete.sql
@@ -72,3 +72,39 @@ SET
modified = :modified
WHERE
id = :reaction-id
+
+----------------------begin components of delete-actor-----
+-- :name delete-actor-and-dependents!
+-- :command :execute
+-- :result :affected
+DELETE FROM statement_to_statement
+WHERE ancestor_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+)
+OR descendant_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+);
+
+DELETE FROM statement_to_activity WHERE statement_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+);
+
+DELETE FROM attachment WHERE statement_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+);
+
+DELETE FROM xapi_statement WHERE statement_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+);
+
+DELETE FROM agent_profile_document WHERE agent_ifi = :actor-ifi;
+
+DELETE FROM state_document WHERE agent_ifi = :actor-ifi;
+
+DELETE FROM actor WHERE actor_ifi = :actor-ifi;
+------------------end delete-actor--------------------
diff --git a/src/db/sqlite/lrsql/sqlite/record.clj b/src/db/sqlite/lrsql/sqlite/record.clj
index 5fdd5008f..e3aeee01f 100644
--- a/src/db/sqlite/lrsql/sqlite/record.clj
+++ b/src/db/sqlite/lrsql/sqlite/record.clj
@@ -109,6 +109,8 @@
(when-not (some? (query-xapi-statement-reaction-id-exists tx))
(xapi-statement-add-reaction-id! tx)
(xapi-statement-add-trigger-id! tx))
+ (when-not (= "CASCADE" (:on-delete (first (query-statement-to-actor-has-cascade-delete? tx))))
+ (update-schema-simple! tx alter-statement-to-actor-add-cascade-delete!))
(log/infof "sqlite schema_version: %d"
(:schema_version (query-schema-version tx))))
@@ -140,6 +142,15 @@
(insert-statement-to-actor! tx input))
(-update-actor! [_ tx input]
(update-actor! tx input))
+ (-delete-actor! [_ tx input]
+ (delete-actor-st2st tx input)
+ (delete-actor-st2activ tx input)
+ (delete-actor-attachments tx input)
+ (delete-actor-statements tx input)
+ (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/db/sqlite/lrsql/sqlite/sql/ddl.sql b/src/db/sqlite/lrsql/sqlite/sql/ddl.sql
index 8a7a64df2..d3adb9a26 100644
--- a/src/db/sqlite/lrsql/sqlite/sql/ddl.sql
+++ b/src/db/sqlite/lrsql/sqlite/sql/ddl.sql
@@ -427,7 +427,6 @@ ALTER TABLE activity_profile_document DROP COLUMN last_modified;
-- :doc Convert `activity_profile_document.last_modified` to timestamp - 04
ALTER TABLE activity_profile_document RENAME COLUMN last_modified_tmp TO last_modified;
-
/* Migration 2023-07-21-00 - Add Reaction Table */
-- :name create-reaction-table!
@@ -458,3 +457,27 @@ ALTER TABLE xapi_statement ADD COLUMN reaction_id TEXT REFERENCES reaction(id);
-- :command :execute
-- :doc Adds `xapi_statement.trigger_id`
ALTER TABLE xapi_statement ADD COLUMN trigger_id TEXT REFERENCES xapi_statement(statement_id);
+
+--:name query-statement-to-actor-has-cascade-delete?
+SELECT on_delete FROM pragma_foreign_key_list("statement_to_actor") WHERE "table" = "xapi_statement"
+
+-- :name alter-statement-to-actor-add-cascade-delete!
+-- :command :execute
+UPDATE sqlite_schema
+SET sql = 'CREATE TABLE statement_to_actor (
+ id TEXT NOT NULL PRIMARY KEY, -- uuid
+ statement_id TEXT NOT NULL, -- uuid
+ usage TEXT NOT NULL CHECK (
+ usage IN (''Actor'', ''Object'', ''Authority'', ''Instructor'', ''Team'',
+ ''SubActor'', ''SubObject'', ''SubInstructor'', ''SubTeam'')
+ ), -- enum
+ actor_ifi TEXT NOT NULL, -- ifi string
+ actor_type TEXT NOT NULL CHECK (
+ actor_type IN (''Agent'', ''Group'')
+ ), -- enum
+
+ FOREIGN KEY (statement_id) REFERENCES xapi_statement(statement_id)
+ ON DELETE CASCADE,
+ FOREIGN KEY (actor_ifi, actor_type) REFERENCES actor(actor_ifi, actor_type)
+)'
+WHERE type = 'table' AND name = 'statement_to_actor'
diff --git a/src/db/sqlite/lrsql/sqlite/sql/delete.sql b/src/db/sqlite/lrsql/sqlite/sql/delete.sql
index 3a34f5329..95a4250c9 100644
--- a/src/db/sqlite/lrsql/sqlite/sql/delete.sql
+++ b/src/db/sqlite/lrsql/sqlite/sql/delete.sql
@@ -70,3 +70,56 @@ SET
modified = :modified
WHERE
id = :reaction-id
+
+----------------------begin components of delete-actor-----
+-- :name delete-actor-st2st
+-- :command :execute
+-- :result :affected
+DELETE FROM statement_to_statement
+WHERE ancestor_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+)
+OR descendant_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+);
+
+-- :name delete-actor-st2activ
+-- :command :execute
+-- :result :affected
+DELETE FROM statement_to_activity WHERE statement_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+);
+
+-- :name delete-actor-attachments
+-- :command :execute
+-- :result :affected
+DELETE FROM attachment WHERE statement_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+);
+
+-- :name delete-actor-statements
+-- :command :execute
+-- :result :affected
+DELETE FROM xapi_statement WHERE statement_id IN (
+ SELECT statement_id FROM statement_to_actor
+ WHERE actor_ifi = :actor-ifi
+);
+
+-- :name delete-actor-agent-profile
+-- :command :execute
+-- :result :affected
+DELETE FROM agent_profile_document WHERE agent_ifi = :actor-ifi
+
+-- :name delete-actor-state-document
+-- :command :execute
+-- :result :affected
+DELETE FROM state_document WHERE agent_ifi = :actor-ifi
+
+-- :name delete-actor-actor
+-- :command :execute
+-- :result :affected
+DELETE FROM actor WHERE actor_ifi = :actor-ifi
diff --git a/src/main/lrsql/admin/interceptors/lrs_management.clj b/src/main/lrsql/admin/interceptors/lrs_management.clj
new file mode 100644
index 000000000..76f326ebb
--- /dev/null
+++ b/src/main/lrsql/admin/interceptors/lrs_management.clj
@@ -0,0 +1,33 @@
+(ns lrsql.admin.interceptors.lrs-management
+ (:require [clojure.spec.alpha :as s]
+ [io.pedestal.interceptor :refer [interceptor]]
+ [io.pedestal.interceptor.chain :as chain]
+ [lrsql.admin.protocol :as adp]
+ [lrsql.spec.admin :as ads]))
+
+(def validate-delete-actor-params
+ (interceptor
+ {:name ::validate-delete-actor-params
+ :enter (fn validate-delete-params [ctx]
+ (let [params (get-in ctx [:request :json-params])]
+ (if-some [err (s/explain-data
+ ads/delete-actor-spec
+ params)]
+ (assoc (chain/terminate ctx)
+ :response
+ {:status 400
+ :body {:error (format "Invalid parameters:\n%s"
+ (-> err s/explain-out with-out-str))}})
+ (assoc ctx ::data params))))}))
+
+(def delete-actor
+ (interceptor
+ {:name ::delete-actor
+ :enter (fn delete-actor [ctx]
+ (let [{lrs :com.yetanalytics/lrs
+ params ::data}
+ ctx]
+ (adp/-delete-actor lrs params)
+ (assoc ctx
+ :response {:status 200
+ :body params})))}))
diff --git a/src/main/lrsql/admin/interceptors/ui.clj b/src/main/lrsql/admin/interceptors/ui.clj
index ac49276ec..a15590bd9 100644
--- a/src/main/lrsql/admin/interceptors/ui.clj
+++ b/src/main/lrsql/admin/interceptors/ui.clj
@@ -14,10 +14,12 @@
config to inject:
:enable-admin-status - boolean, determines if the admin status endpoint is
enabled."
- [{:keys [enable-admin-status
+ [{:keys [enable-admin-delete-actor
+ enable-admin-status
enable-reactions
no-val?]
- :or {enable-admin-status false
+ :or {enable-admin-delete-actor false
+ enable-admin-status false
enable-reactions false
no-val? false}}]
(interceptor
@@ -34,6 +36,7 @@
(merge
{:url-prefix url-prefix
:enable-stmt-html (some? enable-stmt-html)
+ :enable-admin-delete-actor enable-admin-delete-actor
:enable-admin-status enable-admin-status
:enable-reactions enable-reactions
:no-val? no-val?}
diff --git a/src/main/lrsql/admin/protocol.clj b/src/main/lrsql/admin/protocol.clj
index 48cec8dd9..4dbf6766a 100644
--- a/src/main/lrsql/admin/protocol.clj
+++ b/src/main/lrsql/admin/protocol.clj
@@ -41,3 +41,6 @@
"Update a reaction with a new title, ruleset and/or active status")
(-delete-reaction [this reaction-id]
"Soft-delete a reaction."))
+
+(defprotocol AdminLRSManager
+ (-delete-actor [this params]))
diff --git a/src/main/lrsql/admin/routes.clj b/src/main/lrsql/admin/routes.clj
index cd186dc4b..d1987b263 100644
--- a/src/main/lrsql/admin/routes.clj
+++ b/src/main/lrsql/admin/routes.clj
@@ -5,6 +5,7 @@
[com.yetanalytics.lrs.pedestal.interceptor :as i]
[lrsql.admin.interceptors.account :as ai]
[lrsql.admin.interceptors.credentials :as ci]
+ [lrsql.admin.interceptors.lrs-management :as lm]
[lrsql.admin.interceptors.ui :as ui]
[lrsql.admin.interceptors.jwt :as ji]
[lrsql.admin.interceptors.status :as si]
@@ -114,7 +115,6 @@
si/get-status)
:route-name :lrsql.admin.status/get]})
-
(defn admin-ui-routes
[common-interceptors inject-config]
#{;; Redirect root to admin UI
@@ -164,6 +164,14 @@
ri/delete-reaction)
:route-name :lrsql.admin.reaction/delete]})
+(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]})
+
(defn add-admin-routes
"Given a set of routes `routes` for a default LRS implementation,
add additional routes specific to creating and updating admin
@@ -177,6 +185,7 @@
no-val-uname
no-val-role-key
no-val-role
+ enable-admin-delete-actor
enable-admin-ui
enable-admin-status
enable-account-routes
@@ -205,12 +214,15 @@
(admin-ui-routes
(into common-interceptors
oidc-ui-interceptors)
- {:enable-admin-status enable-admin-status
- :enable-reactions enable-reaction-routes
- :no-val? no-val?}))
+ {:enable-admin-status enable-admin-status
+ :enable-reactions enable-reaction-routes
+ :enable-admin-delete-actor enable-admin-delete-actor
+ :no-val? no-val?}))
(when enable-admin-status
(admin-status-routes
common-interceptors-oidc secret leeway no-val-opts))
(when enable-reaction-routes
(admin-reaction-routes
- common-interceptors secret leeway no-val-opts)))))
+ common-interceptors secret leeway no-val-opts))
+ (when enable-admin-delete-actor
+ (admin-lrs-management-routes common-interceptors-oidc secret leeway no-val-opts)))))
diff --git a/src/main/lrsql/backend/protocol.clj b/src/main/lrsql/backend/protocol.clj
index e9e580bf0..1c95aba36 100644
--- a/src/main/lrsql/backend/protocol.clj
+++ b/src/main/lrsql/backend/protocol.clj
@@ -38,6 +38,7 @@
(-insert-actor! [this tx input])
(-insert-statement-to-actor! [this tx input])
(-update-actor! [this tx input])
+ (-delete-actor! [this tx input])
;; Queries
(-query-actor [this tx input]))
diff --git a/src/main/lrsql/input/actor.clj b/src/main/lrsql/input/actor.clj
index 90f154f31..0c342682c 100644
--- a/src/main/lrsql/input/actor.clj
+++ b/src/main/lrsql/input/actor.clj
@@ -61,6 +61,17 @@
:actor-ifi actor-ifi
:actor-type actor-type})
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Actor Delete
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/fdef delete-actor-input
+ :args (s/cat :actor-ifi :lrsql.spec.actor/actor-ifi)
+ :ret (s/keys :req-un [:lrsql.spec.actor/actor-ifi]))
+
+(defn delete-actor-input [actor-ifi]
+ {:actor-ifi actor-ifi})
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Actor Query
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/src/main/lrsql/ops/command/statement.clj b/src/main/lrsql/ops/command/statement.clj
index 1fa075def..ea0567184 100644
--- a/src/main/lrsql/ops/command/statement.clj
+++ b/src/main/lrsql/ops/command/statement.clj
@@ -71,6 +71,10 @@
(bp/-update-actor! bk tx input)))
(bp/-insert-actor! bk tx input)))
+(defn delete-actor!
+ [bk tx input];should just be {:actor-ifi actor-ifi}
+ (bp/-delete-actor! bk tx input))
+
(defn- insert-activity!
[bk tx input]
(if-some [old-activ (some->> (select-keys input [:activity-iri])
diff --git a/src/main/lrsql/spec/admin.clj b/src/main/lrsql/spec/admin.clj
index e0fed2ba3..99314c3dc 100644
--- a/src/main/lrsql/spec/admin.clj
+++ b/src/main/lrsql/spec/admin.clj
@@ -153,3 +153,6 @@
(def update-admin-password-ret-spec
(s/keys :req-un [:lrsql.spec.admin.update-password/result]))
+
+(def delete-actor-spec
+ (s/keys :req-un [:lrsql.spec.actor/actor-ifi]))
diff --git a/src/main/lrsql/system/lrs.clj b/src/main/lrsql/system/lrs.clj
index d16d6b760..e5851824f 100644
--- a/src/main/lrsql/system/lrs.clj
+++ b/src/main/lrsql/system/lrs.clj
@@ -391,4 +391,11 @@
(let [conn (lrs-conn this)
input (react-input/delete-reaction-input reaction-id)]
(jdbc/with-transaction [tx conn]
- (react-cmd/delete-reaction! backend tx input)))))
+ (react-cmd/delete-reaction! backend tx input))))
+
+ adp/AdminLRSManager
+ (-delete-actor [this {:keys [actor-ifi]}]
+ (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)))))
diff --git a/src/main/lrsql/system/webserver.clj b/src/main/lrsql/system/webserver.clj
index 7830cef4d..8fb405050 100644
--- a/src/main/lrsql/system/webserver.clj
+++ b/src/main/lrsql/system/webserver.clj
@@ -24,6 +24,7 @@
ssl-port
url-prefix
key-password
+ enable-admin-delete-actor
enable-admin-ui
enable-admin-status
enable-stmt-html
@@ -69,21 +70,22 @@
(handle-json-parse-exn)]
oidc-resource-interceptors)})
(add-admin-routes
- {:lrs lrs
- :exp jwt-exp
- :leeway jwt-lwy
- :no-val? jwt-no-val
- :no-val-issuer jwt-no-val-issuer
- :no-val-uname jwt-no-val-uname
- :no-val-role-key jwt-no-val-role-key
- :no-val-role jwt-no-val-role
- :secret private-key
- :enable-admin-ui enable-admin-ui
- :enable-admin-status enable-admin-status
- :enable-account-routes enable-local-admin
- :enable-reaction-routes enable-reactions
- :oidc-interceptors oidc-admin-interceptors
- :oidc-ui-interceptors oidc-admin-ui-interceptors
+ {:lrs lrs
+ :exp jwt-exp
+ :leeway jwt-lwy
+ :no-val? jwt-no-val
+ :no-val-issuer jwt-no-val-issuer
+ :no-val-uname jwt-no-val-uname
+ :no-val-role-key jwt-no-val-role-key
+ :no-val-role jwt-no-val-role
+ :secret private-key
+ :enable-admin-delete-actor enable-admin-delete-actor
+ :enable-admin-ui enable-admin-ui
+ :enable-admin-status enable-admin-status
+ :enable-account-routes enable-local-admin
+ :enable-reaction-routes enable-reactions
+ :oidc-interceptors oidc-admin-interceptors
+ :oidc-ui-interceptors oidc-admin-ui-interceptors
:head-opts
{:sec-head-hsts sec-head-hsts
:sec-head-frame sec-head-frame
diff --git a/src/test/lrsql/admin/protocol_test.clj b/src/test/lrsql/admin/protocol_test.clj
index 9fd12ed33..823f06f22 100644
--- a/src/test/lrsql/admin/protocol_test.clj
+++ b/src/test/lrsql/admin/protocol_test.clj
@@ -5,9 +5,12 @@
[com.yetanalytics.lrs.protocol :as lrsp]
[xapi-schema.spec.regex :refer [Base64RegEx]]
[lrsql.admin.protocol :as adp]
+ [lrsql.lrs-test :as lrst]
[lrsql.test-support :as support]
[lrsql.util :as u]
- [lrsql.test-constants :as tc]))
+ [lrsql.test-constants :as tc]
+ [next.jdbc :as jdbc]
+ [lrsql.util.actor :as ua]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Init
@@ -53,6 +56,32 @@
"object" {"id" "http://www.example.com/tincan/activities/multipart"}
"context" {"platform" "another_example"}})
+;; A third statement with a different actor, referring to stmt-0
+(def stmt-2
+ {"id" "00000000-0000-4000-8000-000000000002"
+ "actor" {"account" {"name" "Sample Agent 2"
+ "homePage" "https://example.org"}
+ "name" "Sample Agent 2"
+ "objectType" "Agent"}
+ "verb" {"id" "http://adlnet.gov/expapi/verbs/asked"
+ "display" {"en-US" "asked"}}
+ "object" {"objectType" "StatementRef"
+ "id" "00000000-0000-4000-8000-000000000000"}})
+
+;; A fourth statement (with a third actor) containing a substatement (by a fourth actor
+(def stmt-3
+ {"id" "00000000-0000-4000-8000-000000000003"
+ "actor" {"mbox" "mailto:sample.bar@example.com"
+ "objectType" "Agent"}
+ "verb" {"id" "http://adlnet.gov/expapi/verbs/asked"
+ "display" {"en-US" "asked"}}
+ "object" {"objectType" "SubStatement"
+ "actor" {"mbox" "mailto:sample.baz@example.com"
+ "objectType" "Agent"}
+ "verb" {"id" "http://adlnet.gov/expapi/verbs/answered"
+ "display" {"en-US" "answered"}}
+ "object" {"id" "http://www.example.com/tincan/activities/multipart"}}})
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -60,7 +89,8 @@
(deftest admin-test
(let [sys (support/test-system)
sys' (component/start sys)
- lrs (:lrs sys')]
+ lrs (:lrs sys')
+ ds (-> lrs :connection :conn-pool)]
(testing "Admin account insertion"
(is (-> (adp/-create-account lrs test-username test-password)
:result
@@ -156,6 +186,80 @@
(is (-> (adp/-ensure-account-oidc lrs username bad-issuer)
:result
(= :lrsql.admin/oidc-issuer-mismatch-error)))))
+
+ (testing "delete actor"
+ (testing "delete actor: delete actor"
+ (let [actor (stmt-1 "actor")]
+ (lrsp/-store-statements lrs auth-ident [stmt-1] [])
+ (adp/-delete-actor lrs {:actor-ifi (ua/actor->ifi actor)})
+ (is (= (lrsp/-get-person lrs auth-ident {:agent actor})
+ {:person {"objectType" "Person"}}))))
+ (let [arb-query #(jdbc/execute! ds %)]
+ (testing "delete-actor: delete statements related to actor"
+ (let [stmts [stmt-0 stmt-1 stmt-2 stmt-3]
+ ifis (->> (conj stmts (stmt-3 "object"))
+ (map #(ua/actor->ifi (% "actor"))))
+ get-actor-ss-count (fn [ifi]
+ (-> (lrsp/-get-statements lrs auth-ident {:actor-ifi ifi} [])
+ (get-in [:statement-result :statements])
+ count))
+ get-stmt-#s (fn []
+ (reduce (fn [m actor-ifi]
+ (assoc m actor-ifi (get-actor-ss-count actor-ifi)))
+ {} ifis))]
+
+ (lrsp/-store-statements lrs auth-ident stmts [])
+ (is (every? pos-int? (vals (get-stmt-#s))))
+ (doseq [ifi ifis]
+ (adp/-delete-actor lrs {:actor-ifi ifi}))
+ (is (every? zero? (vals (get-stmt-#s))))))
+ (testing "delete-actor: delete statements related to deleted statements"
+ (let [stmt->ifi #(ua/actor->ifi (% "actor"))
+ count-of-actor (fn [actor-ifi] (-> (lrsp/-get-statements lrs auth-ident {:actor-ifi actor-ifi} []) :statement-result :statements count))
+ child-ifi (stmt->ifi (stmt-3 "object"))
+ parent-ifi (stmt->ifi stmt-3)]
+ (testing "delete-actor correctly deletes statements that are parent to actor (sub)statements"
+ (lrsp/-store-statements lrs auth-ident [stmt-3] [])
+ (is (= 1 (count-of-actor parent-ifi)))
+ (adp/-delete-actor lrs {:actor-ifi child-ifi})
+ (is (zero? (count-of-actor parent-ifi))) ;
+ (adp/-delete-actor lrs {:actor-ifi parent-ifi}))
+ (testing "delete-actor correctly deletes substatements that are child to actor statements"
+ (lrsp/-store-statements lrs auth-ident [stmt-3] [])
+ (is (= 1 (count-of-actor child-ifi)))
+ (adp/-delete-actor lrs {:actor-ifi parent-ifi})
+ (is (zero? (count-of-actor child-ifi)))
+ (adp/-delete-actor lrs {:actor-ifi child-ifi}))
+ (testing "for StatementRefs, delete-actor deletes statement->actor relationships but leaves statements by another actor untouched"
+ (let [[ifi-0 ifi-2] (mapv stmt->ifi [stmt-0 stmt-2])]
+ (lrsp/-store-statements lrs auth-ident [stmt-0 stmt-2] [])
+ (is (= [2 2] (mapv count-of-actor [ifi-0 ifi-2])))
+ (adp/-delete-actor lrs {:actor-ifi ifi-0})
+ (is (= [1 1] (mapv count-of-actor [ifi-0 ifi-2])))
+ (adp/-delete-actor lrs {:actor-ifi ifi-2})
+ (is (= [0 0] (mapv count-of-actor [ifi-0 ifi-2])))))))
+
+ (testing "delete-actor: delete state_document of deleted actor"
+ (let [ifi (ua/actor->ifi (:agent lrst/state-id-params))]
+ (lrsp/-set-document lrs auth-ident lrst/state-id-params lrst/state-doc-1 true)
+ (adp/-delete-actor lrs {:actor-ifi ifi})
+ (is (empty? (arb-query ["select * from state_document where agent_ifi = ?" ifi])))))
+
+ (testing "delete-actor: delete agent profile document of deleted actor"
+ (let [{:keys [agent profileId]} lrst/agent-prof-id-params
+ ifi (ua/actor->ifi agent)]
+ (lrsp/-set-document lrs auth-ident lrst/agent-prof-id-params lrst/agent-prof-doc true)
+ (adp/-delete-actor lrs {:actor-ifi ifi})
+ (is (nil? (:document (lrsp/-get-document lrs auth-ident {:profileId profileId
+ :agent agent}))))))
+ (testing "delete-actor: delete attachments of deleted statements"
+ (let [ifi (ua/actor->ifi (lrst/stmt-4 "actor"))
+ stmt-id (u/str->uuid (lrst/stmt-4 "id"))]
+ (lrsp/-store-statements lrs auth-ident [lrst/stmt-4] [lrst/stmt-4-attach])
+ (adp/-delete-actor lrs {:actor-ifi ifi})
+ (is (empty? (:attachments (lrsp/-get-statements lrs auth-ident {:statement_id stmt-id} []))))
+ (testing "delete actor: delete statement-to-activity entries for deleted statements"
+ (is (empty? (arb-query ["select * from statement_to_activity where statement_id = ?" stmt-id]))))))))
(component/stop sys')))
;; TODO: Add tests for creds with no explicit scopes, once
diff --git a/src/test/lrsql/admin/route_test.clj b/src/test/lrsql/admin/route_test.clj
index d00f38cbc..85b74f1d4 100644
--- a/src/test/lrsql/admin/route_test.clj
+++ b/src/test/lrsql/admin/route_test.clj
@@ -6,11 +6,13 @@
[babashka.curl :as curl]
[com.stuartsierra.component :as component]
[xapi-schema.spec.regex :refer [Base64RegEx]]
+ [com.yetanalytics.lrs.protocol :as lrsp]
[lrsql.test-support :as support]
[lrsql.test-constants :as tc]
[lrsql.util :as u]
[lrsql.util.headers :as h]
- [lrsql.util.reaction :as ru]))
+ [lrsql.util.reaction :as ru]
+ [lrsql.util.actor :as ua]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Init
@@ -20,6 +22,24 @@
(use-fixtures :each support/fresh-db-fixture)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Test data
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def auth-ident {:agent {"objectType" "Agent"
+ "account" {"homePage" "http://example.org"
+ "name" "12341234-0000-4000-1234-123412341234"}}
+ :scopes #{:scope/all}})
+
+(def stmt-0 {"id" "00000000-0000-4000-8000-000000000000"
+ "actor" {"mbox" "mailto:sample.foo@example.com"
+ "objectType" "Agent"}
+ "verb" {"id" "http://adlnet.gov/expapi/verbs/answered"
+ "display" {"en-US" "answered"
+ "zh-CN" "回答了"}}
+ "object" {"id" "http://www.example.com/tincan/activities/multipart"}
+ "context" {"platform" "example"}})
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test content
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -72,6 +92,11 @@
(curl/get "http://localhost:8080/admin/status"
{:headers headers}))
+(defn- delete-actor
+ [headers body]
+ (curl/delete "http://0.0.0.0:8080/admin/agents" {:headers headers
+ :body body}))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -381,6 +406,18 @@
(testing "omitted sec headers because not configured"
(let [{:keys [headers]} (get-env content-type)]
(is (empty? (select-keys headers sec-header-names)))))
+ (testing "delete actor route"
+ (let [lrs (:lrs sys')
+
+ ifi (ua/actor->ifi (stmt-0 "actor"))
+ count-by-id (fn [id]
+ (-> (lrsp/-get-statements lrs auth-ident {:statementsId id} [])
+ :statement-result :statements count))]
+ (lrsp/-store-statements lrs auth-ident [stmt-0] [])
+ (is (= 1 (count-by-id (stmt-0 "id"))))
+ (delete-actor headers
+ (u/write-json-str {"actor-ifi" ifi}))
+ (is (zero? (count-by-id (stmt-0 "id"))))))
(finally
(component/stop sys')))))