penpot/backend/test/backend_tests/rpc_admin_delete_test.clj

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL

(ns backend-tests.rpc-admin-delete-test
  "Tests for the superuser-guarded delete commands."
  (:require
   [app.auth :as-alias auth]
   [app.common.data :as d]
   [app.common.time :as ct]
   [app.common.uuid :as uuid]
   [app.db :as db]
   [app.http :as-alias http]
   [app.rpc :as rpc]
   [app.util.services :as sv]
   [backend-tests.helpers :as th]
   [clojure.test :as t]))

(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)

;; ----------------------------------------------------------------
;; Helpers
;; ----------------------------------------------------------------

(defn- raw-method
  "The raw [f mdata] behind `cmd-name` in the admin namespace."
  [cmd-name]
  (some (fn [[f mdata]]
          (when (= cmd-name (::sv/name mdata))
            [f mdata]))
        (sv/scan-ns 'app.rpc.admin.file
                    'app.rpc.admin.project
                    'app.rpc.admin.team
                    'app.rpc.admin.profile)))

(defn- call
  "Invoke an admin command through the real wrapper chain with a
  hand-built config.

  The chain closes over its cfg at startup, so the superuser set is
  injected per call here instead of going through `th/command!`.
  Qualified keys stay in `params` as server context; the rest goes
  into the request, where params validation reads it from."
  [superusers auth-type profile-id token-perms cmd params]
  (let [[f mdata]   (raw-method cmd)
        cfg         (assoc th/*system* ::auth/superusers superusers)
        request     (assoc (th/make-dummy-request)
                           :params (d/without-qualified params))
        server      (with-meta params {::rpc/request-at (ct/now)
                                       ::http/request request})
        wrapped     (#'rpc/wrap cfg f mdata)]
    (wrapped cfg (assoc server
                        ::rpc/profile-id profile-id
                        ::rpc/auth-type auth-type
                        ::rpc/token-perms token-perms))))

(defn- as-session
  [superusers profile]
  (fn [cmd params]
    (call superusers :session (:id profile) #{} cmd params)))

(defn- as-superuser
  [profile]
  (as-session #{(:id profile)} profile))

(defn- caught-code
  "Run `thunk` and return the error code it raised, or `::no-throw`."
  [thunk]
  (try
    (thunk)
    ::no-throw
    (catch clojure.lang.ExceptionInfo cause
      (th/ex-code cause))))

(defn- create-file
  [i]
  (let [profile (th/create-profile* i)
        team    (th/create-team* i {:profile-id (:id profile)})
        project (th/create-project* i {:profile-id (:id profile)
                                       :team-id (:id team)})
        file    (th/create-file* i {:profile-id (:id profile)
                                    :project-id (:id project)})]
    {:profile profile :team team :project project :file file}))

(defn- deleted-at
  "Raw `deleted_at`, bypassing the soft-delete filter."
  [table match]
  (:deleted-at (db/get* th/*system* table match {::db/remove-deleted false})))

;; ----------------------------------------------------------------
;; Guard
;; ----------------------------------------------------------------

(t/deftest unlisted-session-rejected
  (let [profile (th/create-profile* 1)
        run     (as-session #{} profile)
        missing (uuid/next)]
    (t/is (= :superuser-required
             (caught-code #(run "delete-team" {:id missing}))))
    (t/is (= :superuser-required
             (caught-code #(run "delete-project" {:id missing}))))
    (t/is (= :superuser-required
             (caught-code #(run "delete-file" {:id missing}))))))

;; ----------------------------------------------------------------
;; Not found
;; ----------------------------------------------------------------

(t/deftest delete-unknown-ids-give-not-found
  (let [profile (th/create-profile* 1)
        run     (as-superuser profile)
        missing (uuid/next)]
    (t/is (= :team-not-found
             (caught-code #(run "delete-team" {:id missing}))))
    (t/is (= :project-not-found
             (caught-code #(run "delete-project" {:id missing}))))
    (t/is (= :file-not-found
             (caught-code #(run "delete-file" {:id missing}))))))

;; ----------------------------------------------------------------
;; Delete cascades
;; ----------------------------------------------------------------

(t/deftest delete-team-deletes-cascade
  (let [{:keys [profile team project file]} (create-file 1)
        run   (as-superuser profile)
        out   (run "delete-team" {:id (:id team)})]
    (t/is (= (:id team) (:id out)))
    (t/is (not (contains? out :recursive)))
    (t/is (some? (deleted-at :team {:id (:id team)})))
    (t/is (nil? (deleted-at :project {:id (:id project)})))
    (th/run-pending-jobs)
    (t/is (some? (deleted-at :project {:id (:id project)})))
    (t/is (some? (deleted-at :file {:id (:id file)})))
    (t/is (some? (deleted-at :file-data {:file-id (:id file)})))))

(t/deftest delete-project-deletes-files
  (let [{:keys [profile project file]} (create-file 1)
        run   (as-superuser profile)
        out   (run "delete-project" {:id (:id project)})]
    (t/is (= (:id project) (:id out)))
    (t/is (some? (deleted-at :project {:id (:id project)})))
    (t/is (nil? (deleted-at :file {:id (:id file)})))
    (th/run-pending-jobs)
    (t/is (some? (deleted-at :file {:id (:id file)})))
    (t/is (some? (deleted-at :file-data {:file-id (:id file)})))))

(t/deftest delete-file-deletes-rows
  (let [{:keys [profile file]} (create-file 1)
        run   (as-superuser profile)
        out   (run "delete-file" {:id (:id file)})]
    (t/is (= (:id file) (:id out)))
    (t/is (some? (deleted-at :file {:id (:id file)})))
    (t/is (nil? (deleted-at :file-data {:file-id (:id file)})))
    (th/run-pending-jobs)
    (t/is (some? (deleted-at :file-data {:file-id (:id file)})))
    (t/is (false? (:is-shared (db/get* th/*system* :file {:id (:id file)}
                                       {::db/remove-deleted false}))))))

;; ----------------------------------------------------------------
;; Defaults are protected
;; ----------------------------------------------------------------

(t/deftest delete-default-team-refused
  (let [{:keys [profile team]} (create-file 1)
        run   (as-superuser profile)]
    (db/update! th/*system* :team {:is-default true} {:id (:id team)})
    (t/is (= :non-deletable-team
             (caught-code #(run "delete-team" {:id (:id team)}))))
    (t/is (nil? (deleted-at :team {:id (:id team)})))))

(t/deftest delete-default-project-refused
  (let [{:keys [profile project]} (create-file 1)
        run   (as-superuser profile)]
    (db/update! th/*system* :project {:is-default true} {:id (:id project)})
    (t/is (= :non-deletable-project
             (caught-code #(run "delete-project" {:id (:id project)}))))
    (t/is (nil? (deleted-at :project {:id (:id project)})))))

;; ----------------------------------------------------------------
;; Already deleted is a no-op
;; ----------------------------------------------------------------

(t/deftest delete-already-deleted-team-is-noop
  (let [{:keys [profile team]} (create-file 1)
        run   (as-superuser profile)
        _     (run "delete-team" {:id (:id team)})
        first (deleted-at :team {:id (:id team)})
        out   (run "delete-team" {:id (:id team)})]
    (t/is (= (:id team) (:id out)))
    (t/is (= first (deleted-at :team {:id (:id team)})))))