mirror of
https://github.com/penpot/penpot.git
synced 2026-11-04 09:00:37 +00:00
57fa280209
* 🐛 Decode job results with the schema of the job-def A job result is stored as plain JSON, so a uuid comes back as the text it is on disk and a uuid used as a map key comes back as a keyword. The import resolution is a map keyed by file id, and the wizard lost that identity: choosing a library in the link step created no link at all, with no error and with the modal closing as if it had worked. A job-def can now declare a result schema and its precompiled decoder, the pair the params already have, and the substrate applies them when the row is read. A def that declares neither answers with the JSON the row holds, as before; a row whose job-def is gone is read untouched instead of raising. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 🐛 Type the import result so its resolution keeps uuid keys The resolution of a version 3 import is a map keyed by the new file id, and the result column is plain JSON: without a schema of its own every key came back as a keyword while the :id of the entry came back as text, so the dashboard wizard could not match the file it was linking and created no library link at all. Declare the shape of the resolution (files, done and pending entries and their candidates) and give the job-def its result schema and decoder. The check before the result is stored keeps validating the same schema. Closes #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 🐛 Take the imported file id from the entry, not the map key The wizard looked a file up in the selection with the key of the resolution map while it had indexed the selection by the :id of the entry. The key is keywordized on its way through the job result, so the lookup missed and the confirm button created no library link at all, with no error and with the modal closing as if it had worked. Take the id from the entry, the source the rest of the wizard already uses, and move the decision to a pure function covered by tests of both shapes of the resolution. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 🐛 Test that an import result keeps its ids as uuids The regression this branch fixes is only visible through the read path of the substrate: the resolution of an import is a map keyed by the new file id, and a test that works with the value in memory never sees the keys coming back as keywords from the plain JSON column. Import a package whose library needs a replacement chosen by the user, read the result with `jobs/get-job` as the client does, and check the keys, the file ids and the ids of the candidates. Without the result decoder of the import job-def the test answers with text ids. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 📚 Document the result schema of a job-def The memories and the docstring of the substrate said a job result has no schema of its own and comes back as the JSON the row holds. A job-def can now declare its result schema and decoder, and the substrate applies them when the row is read. Keep the rule next to it: a result map keyed by uuid needs its schema declared, or every key comes back as a keyword, and the link-later step of the import wizard takes the file id from the entry and never from the key of the resolution map. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 📚 Fix the documented contract of a job result The docstring of get-job said a result has no schema of its own and comes back as the JSON the row holds, which is what this branch changes: the result is decoded with the schema its job-def declares, and a result that does not conform never reaches the column because the write validates it. Say the same in the management command that stores the result of an external worker, the other writer of the column. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 🐛 Check the result of a job against its schema before storing it The result of a job crosses a plain JSON column, so a uuid comes back as text and a uuid used as a map key as a keyword. The job-def now declares the schema of its result and the substrate compiles the decoder from it, which is what the read path uses to get the types back. The same schema is the contract of the write path: complete refuses a result that does not conform, with the malli explanation, so nothing invalid reaches the column, and the answer is the same for the runner and for the external worker that completes a job through the management RPC. A job that is no longer completable is skipped without checking, and the read path decodes only: a row written by another version stays readable. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 🐛 Check the result of an import inside its transaction The check ran after the transaction of the import had committed, so a result the schema does not accept failed the job with the files already created in the destination project: a half imported project and an error. The core decides whether the whole import is kept or rolled back, so the check belongs inside its transaction, which is what turns a contract violation into a rollback. The substrate checks the result again when the job is completed, which is the only net for a job that does not validate its own result. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 🐛 Cover the edges of an import result read by the client The shape of a result with no libraries to resolve, and the one of a version 1 import, is the most common in production and neither was covered by the tests that read a result the way the client does. Cover both through jobs/get-job, and the case of a registry that no longer knows the kind of the row: it answers with the JSON of the column, keywordized keys and uuid as text, instead of raising. Say in the two tests that depend on the decoder what implementation without it makes them fail. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * 📚 Fix the prose and the fixtures of the result contract The result schema of a job-def is what the read decodes with and what the write checks: say that in the memories, with the rule that any uuid of a result needs it, whether a value or a map key. The motive of the wizard helper was a fact this branch makes false: what a key of the resolution map holds depends on the result schema of the job-def that wrote it, so the rule is to read the id from the entry. Same correction in its memory and in the test that pins the shape. The candidates of a pending entry match by slugified name, not by name, and every test row now states the kind of its job, because the name is what resolves its job-def when the result is read or checked. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * ♻️ Keep the wizard link helper private and cover its shape The helper that decides which links the wizard creates belongs to its namespace, as its neighbours do: reach it from the test with @#', the pattern the frontend tests already use for a private helper. Cover the shapes it had no test for: a file with two libraries pending resolution, a file whose libraries were auto-linked, and a selection where only one of two entries was resolved. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> * ♻️ Share one job-row helper across the job tests Three test namespaces had their own copy of the same insert, differing only in the kind of the job and in whether the row holds the resource it consumes. Move it to the test helpers as create-job*, with the kind of the job as its first argument: it is what resolves the job-def of the row when its result is read or checked, so every test states it. The bang of the name goes away with it: the design rules keep it for the mutating API of app.db, and this is a fixture of the tests. The three namespaces lose the requires that only their removed copy used. Relates to #12339 AI-assisted-by: deepseek-v4.1-flash Signed-off-by: Andrey Antukh <niwi@niwi.nz> --------- Signed-off-by: Andrey Antukh <niwi@niwi.nz>
815 lines
28 KiB
Clojure
815 lines
28 KiB
Clojure
;; 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.helpers
|
|
(:require
|
|
[app.auth]
|
|
[app.common.data :as d]
|
|
[app.common.data.macros :as dm]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.features :as cfeat]
|
|
[app.common.flags :as flags]
|
|
[app.common.pprint :as pp]
|
|
[app.common.schema :as sm]
|
|
[app.common.spec :as us]
|
|
[app.common.time :as ct]
|
|
[app.common.transit :as tr]
|
|
[app.common.uuid :as uuid]
|
|
[app.config :as cf]
|
|
[app.db :as db]
|
|
[app.jobs :as jobs]
|
|
[app.main :as main]
|
|
[app.media]
|
|
[app.media :as-alias mtx]
|
|
[app.metrics :as-alias metrics]
|
|
[app.migrations]
|
|
[app.msgbus :as-alias mbus]
|
|
[app.rpc :as-alias rpc]
|
|
[app.rpc.climit :as-alias climit]
|
|
[app.rpc.commands.auth :as cmd.auth]
|
|
[app.rpc.commands.files :as files]
|
|
[app.rpc.commands.files-create :as files.create]
|
|
[app.rpc.commands.files-update :as files.update]
|
|
[app.rpc.commands.projects :as projects]
|
|
[app.rpc.commands.teams :as teams]
|
|
[app.rpc.helpers :as rph]
|
|
[app.util.blob :as blob]
|
|
[app.util.services :as sv]
|
|
[app.worker.runner]
|
|
[clojure.java.io :as io]
|
|
[clojure.spec.alpha :as s]
|
|
[clojure.test :as t]
|
|
[cuerdas.core :as str]
|
|
[datoteka.fs :as fs]
|
|
[environ.core :refer [env]]
|
|
[expound.alpha :as expound]
|
|
[integrant.core :as ig]
|
|
[mockery.core :as mk]
|
|
[promesa.core :as p]
|
|
[promesa.exec :as px]
|
|
[ring.core.protocols :as rcp]
|
|
[yetti.request :as yreq]
|
|
[yetti.response :as yres])
|
|
(:import
|
|
java.io.PipedInputStream
|
|
java.io.PipedOutputStream
|
|
java.util.UUID
|
|
org.postgresql.ds.PGSimpleDataSource))
|
|
|
|
(def ^:dynamic *system* nil)
|
|
(def ^:dynamic *pool* nil)
|
|
|
|
;; Fallback values used when no PENPOT_TEST_* env vars are set (e.g. CI sets
|
|
;; them explicitly, see .github/workflows/tests-backend.yml). Inside the
|
|
;; devenv each wsN container receives per-instance values via
|
|
;; manage.sh (PENPOT_TEST_DATABASE_URI=postgresql://postgres/penpot_test_wsN,
|
|
;; PENPOT_TEST_REDIS_URI=redis://valkey/<6+N>), so parallel test runs on
|
|
;; different workspaces never share a database. cf/read-config picks the env
|
|
;; vars up through the "penpot-test" prefix.
|
|
(def default
|
|
{:database-uri "postgresql://postgres/penpot_test"
|
|
:redis-uri "redis://valkey/1"
|
|
:auto-file-snapshot-every 1
|
|
:file-data-backend "db"})
|
|
|
|
(def config
|
|
(cf/read-config :prefix "penpot-test"
|
|
:default (merge cf/default default)))
|
|
|
|
(def default-flags
|
|
[:enable-secure-session-cookies
|
|
:enable-email-verification
|
|
:enable-smtp
|
|
:enable-quotes
|
|
:enable-rpc-climit
|
|
:enable-auto-file-snapshot
|
|
:disable-file-validation])
|
|
|
|
(defn init-config
|
|
([next]
|
|
(init-config nil next))
|
|
([extra-flags next]
|
|
(let [flags (into default-flags extra-flags)]
|
|
(with-redefs [app.config/flags (flags/parse flags/default flags)
|
|
app.config/config config
|
|
app.loggers.audit/submit (constantly nil)
|
|
app.auth/derive-password identity
|
|
app.auth/verify-password (fn [a b] {:valid (= a b)})
|
|
app.common.features/get-enabled-features
|
|
(fn [& _] app.common.features/supported-features)]
|
|
(cf/validate! :exit-on-error? false)
|
|
(fs/create-dir "/tmp/penpot")
|
|
(next)))))
|
|
|
|
(defn- remove-job-runners
|
|
"Drops every `[<profile> :app.worker/runner]` from the system.
|
|
|
|
The tests drive the runner loop by hand (`wdisp/run-batch` plus
|
|
`run-worker-loop` over a system they build themselves), so a live runner
|
|
of any queue races them: it takes the job the test just dispatched and
|
|
completes it behind the test's back. Matching the key by shape, instead
|
|
of listing the known queues by hand, keeps a new queue from silently
|
|
bringing that race back (which is what happened to the `binfile` runner
|
|
this key list was missing)."
|
|
[system]
|
|
(apply dissoc system
|
|
(filter #(and (vector? %)
|
|
(= :app.worker/runner (second %)))
|
|
(keys system))))
|
|
|
|
(defn init-system
|
|
[next]
|
|
(let [templates [{:id "test"
|
|
:name "test"
|
|
:file-uri "test"
|
|
:thumbnail-uri "test"
|
|
:path (-> "backend_tests/test_files/template.penpot" io/resource fs/path)}]
|
|
system (-> (merge main/system-config main/worker-config)
|
|
(assoc-in [:app.redis/client :app.redis/uri] (:redis-uri config))
|
|
(assoc-in [::db/pool ::db/uri] (:database-uri config))
|
|
(assoc-in [::db/pool ::db/username] (:database-username config))
|
|
(assoc-in [::db/pool ::db/password] (:database-password config))
|
|
(assoc-in [:app.rpc/methods :app.setup/templates] templates)
|
|
(assoc-in [:app.rpc/methods :app.setup/templates] templates)
|
|
(update :app.rpc/rlimit assoc
|
|
:app.loggers.mattermost/reporter nil
|
|
:app.loggers.database/reporter nil)
|
|
(update :app.rpc/methods assoc
|
|
:app.setup/templates templates
|
|
:app.loggers.mattermost/reporter nil
|
|
:app.loggers.database/reporter nil)
|
|
(dissoc :app.srepl/server
|
|
:app.http/server
|
|
:app.http/route
|
|
:app.setup/templates
|
|
:app.http.oauth/handler
|
|
:app.notifications/handler
|
|
:app.loggers.mattermost/reporter
|
|
:app.loggers.database/reporter
|
|
:app.worker/cron
|
|
:app.worker/dispatcher)
|
|
(remove-job-runners))
|
|
_ (ig/load-namespaces system)
|
|
system (-> (ig/expand system) (ig/init))]
|
|
(try
|
|
(binding [*system* system
|
|
*pool* (:app.db/pool system)]
|
|
(next))
|
|
(finally
|
|
(ig/halt! system)))))
|
|
|
|
(def state-init
|
|
(t/compose-fixtures init-config init-system))
|
|
|
|
(defn database-reset
|
|
[next]
|
|
(let [sql (str "SELECT table_name "
|
|
" FROM information_schema.tables "
|
|
" WHERE table_schema = 'public' "
|
|
" AND table_name != 'migrations';")]
|
|
(db/transact! *pool* (fn [conn]
|
|
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
|
|
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
|
|
(let [result (->> (db/exec! conn [sql])
|
|
(map :table-name))]
|
|
(doseq [table result]
|
|
(db/exec! conn [(str "delete from " table ";")])))))
|
|
(next)))
|
|
|
|
(defn clean-storage
|
|
[next]
|
|
(let [path (fs/path "/tmp/penpot")]
|
|
(when (fs/exists? path)
|
|
(fs/delete (fs/path "/tmp/penpot")))
|
|
(fs/create-dir "/tmp/penpot")
|
|
(next)))
|
|
|
|
(defn serial
|
|
[& funcs]
|
|
(fn [next]
|
|
(loop [f (first funcs)
|
|
fs (rest funcs)]
|
|
(when f
|
|
(let [prm (promise)]
|
|
(f #(deliver prm true))
|
|
(deref prm)
|
|
(recur (first fs)
|
|
(rest fs)))))
|
|
(next)))
|
|
|
|
(defn mk-uuid
|
|
[prefix & args]
|
|
(UUID/nameUUIDFromBytes (-> (apply str prefix args)
|
|
(.getBytes "UTF-8"))))
|
|
;; --- FACTORIES
|
|
|
|
(defn create-profile*
|
|
([i] (create-profile* *system* i {}))
|
|
([i params] (create-profile* *system* i params))
|
|
([system i params]
|
|
(let [params (merge {:id (mk-uuid "profile" i)
|
|
:fullname (str "Profile " i)
|
|
:email (str "profile" i ".test@nodomain.com")
|
|
:password "Test123!"
|
|
:is-demo false}
|
|
params)]
|
|
(db/run! system
|
|
(fn [cfg]
|
|
(->> params
|
|
(cmd.auth/create-profile cfg)
|
|
(cmd.auth/create-profile-rels cfg)))))))
|
|
|
|
(defn create-project*
|
|
([i params] (create-project* *system* i params))
|
|
([system i {:keys [profile-id team-id] :as params}]
|
|
|
|
(assert (uuid? profile-id))
|
|
(assert (uuid? team-id))
|
|
(let [timestamp (ct/now)]
|
|
(db/run! system
|
|
(fn [cfg]
|
|
(->> (merge {:id (mk-uuid "project" i)
|
|
:name (str "project" i)}
|
|
params
|
|
{::rpc/request-at timestamp})
|
|
(#'projects/create-project cfg)))))))
|
|
|
|
(defn create-file*
|
|
([i params]
|
|
(create-file* *system* i params))
|
|
([system i {:keys [profile-id project-id] :as params}]
|
|
(dm/assert! "expected uuid" (uuid? profile-id))
|
|
(dm/assert! "expected uuid" (uuid? project-id))
|
|
(db/tx-run! system
|
|
(fn [system]
|
|
(let [features (cfeat/get-enabled-features cf/flags)]
|
|
(files.create/create-file system
|
|
(merge {:id (mk-uuid "file" i)
|
|
:name (str "file" i)
|
|
:features features}
|
|
params)))))))
|
|
|
|
(defn create-job*
|
|
"A job row in the state a worker finds it: running, in the `binfile` queue,
|
|
owned by `profile-id` and holding `resource-id` when it consumes one.
|
|
`job-name` is the kind of the job (a keyword like the `::jobs/name` a caller
|
|
would pass, or the text the row holds) and it is what resolves the job-def
|
|
of the row when its result is read or checked."
|
|
[job-name {:keys [profile-id resource-id]}]
|
|
(let [id (uuid/next)]
|
|
(db/insert! *pool* :job {:id id
|
|
:name (name job-name)
|
|
:tenant (cf/get :tenant)
|
|
:queue "binfile"
|
|
:params (db/json {})
|
|
:priority 100
|
|
:max-retries 0
|
|
:retry-num 0
|
|
:status "running"
|
|
:profile-id profile-id
|
|
:resource-id resource-id
|
|
:scheduled-at (ct/now)
|
|
:created-at (ct/now)
|
|
:modified-at (ct/now)})
|
|
id))
|
|
|
|
(defn mark-file-deleted*
|
|
([params]
|
|
(mark-file-deleted* *system* params))
|
|
([system {:keys [id] :as params}]
|
|
(db/tx-run! system
|
|
(fn [cfg]
|
|
(#'files/mark-file-deleted cfg {} id)))))
|
|
|
|
(defn create-team*
|
|
([i params] (create-team* *system* i params))
|
|
([system i {:keys [profile-id] :as params}]
|
|
(us/assert uuid? profile-id)
|
|
(dm/with-open [conn (db/open system)]
|
|
(let [id (mk-uuid "team" i)
|
|
features (cfeat/get-enabled-features cf/flags)]
|
|
(teams/create-team {::db/conn conn} {:id id
|
|
:profile-id profile-id
|
|
:features features
|
|
:name (str "team" i)})))))
|
|
|
|
(defn create-file-media-object*
|
|
([params] (create-file-media-object* *system* params))
|
|
([system {:keys [name width height mtype file-id is-local media-id]
|
|
:or {name "sample" width 100 height 100 mtype "image/svg+xml" is-local true}}]
|
|
|
|
(dm/with-open [conn (db/open system)]
|
|
(db/insert! conn :file-media-object
|
|
{:id (uuid/next)
|
|
:file-id file-id
|
|
:is-local is-local
|
|
:name name
|
|
:media-id media-id
|
|
:width width
|
|
:height height
|
|
:mtype mtype}))))
|
|
|
|
(defn link-file-to-library*
|
|
([params] (link-file-to-library* *system* params))
|
|
([system {:keys [file-id library-id] :as params}]
|
|
(dm/with-open [conn (db/open system)]
|
|
(#'files/link-file-to-library conn {:file-id file-id :library-id library-id}))))
|
|
|
|
(defn create-complaint-for
|
|
[system {:keys [id created-at type]}]
|
|
(dm/with-open [conn (db/open system)]
|
|
(db/insert! conn :profile-complaint-report
|
|
{:profile-id id
|
|
:created-at (or created-at (ct/now))
|
|
:type (name type)
|
|
:content (db/tjson {})})))
|
|
|
|
(defn create-global-complaint-for
|
|
[system {:keys [email type created-at]}]
|
|
(dm/with-open [conn (db/open system)]
|
|
(db/insert! conn :global-complaint-report
|
|
{:email email
|
|
:type (name type)
|
|
:created-at (or created-at (ct/now))
|
|
:content (db/tjson {})})))
|
|
|
|
(defn create-team-role*
|
|
([params] (create-team-role* *system* params))
|
|
([system {:keys [team-id profile-id role] :or {role :owner}}]
|
|
(dm/with-open [conn (db/open system)]
|
|
(#'teams/create-team-role {::db/conn conn}
|
|
{:team-id team-id
|
|
:profile-id profile-id
|
|
:role role}))))
|
|
|
|
(defn create-project-role*
|
|
([params] (create-project-role* *system* params))
|
|
([system {:keys [project-id profile-id role] :or {role :owner}}]
|
|
(dm/with-open [conn (db/open system)]
|
|
(#'teams/create-project-role conn profile-id project-id role))))
|
|
|
|
(defn create-file-role*
|
|
([params] (create-file-role* *system* params))
|
|
([system {:keys [file-id profile-id role] :or {role :owner}}]
|
|
(dm/with-open [conn (db/open system)]
|
|
(files.create/create-file-role! conn {:file-id file-id
|
|
:profile-id profile-id
|
|
:role role}))))
|
|
|
|
(defn update-file*
|
|
([params] (update-file* *system* params))
|
|
([system {:keys [file-id changes session-id profile-id revn]
|
|
:or {session-id (uuid/next) revn 0}}]
|
|
(-> system
|
|
(assoc ::files.update/timestamp (ct/now))
|
|
(db/tx-run! (fn [{:keys [::db/conn] :as system}]
|
|
(let [file (files.update/get-file conn file-id)]
|
|
(#'files.update/update-file* system
|
|
{:id file-id
|
|
:revn revn
|
|
:vern 0
|
|
:file file
|
|
:features (:features file)
|
|
:changes changes
|
|
:session-id session-id
|
|
:profile-id profile-id})))))))
|
|
|
|
(declare command!)
|
|
|
|
(defn update-file! [& {:keys [profile-id file-id changes revn] :or {revn 0}}]
|
|
(let [features (cfeat/get-enabled-features cf/flags)
|
|
params {::type :update-file
|
|
::rpc/profile-id profile-id
|
|
:id file-id
|
|
:session-id (uuid/random)
|
|
:revn revn
|
|
:vern 0
|
|
:features features
|
|
:changes changes}
|
|
out (command! params)]
|
|
(t/is (nil? (:error out)))
|
|
(:result out)))
|
|
|
|
|
|
(defn create-webhook*
|
|
([params] (create-webhook* *system* params))
|
|
([system {:keys [team-id id uri mtype is-active]
|
|
:or {is-active true
|
|
mtype "application/json"
|
|
uri "http://example.com/webhook"}}]
|
|
(db/run! system (fn [{:keys [::db/conn]}]
|
|
(db/insert! conn :webhook
|
|
{:id (or id (uuid/next))
|
|
:team-id team-id
|
|
:uri uri
|
|
:is-active is-active
|
|
:mtype mtype})))))
|
|
|
|
;; --- RPC HELPERS
|
|
|
|
(defn handle-error
|
|
[^Throwable err]
|
|
(if (instance? java.util.concurrent.ExecutionException err)
|
|
(handle-error (.getCause err))
|
|
err))
|
|
|
|
(defmacro try-on!
|
|
[expr]
|
|
`(try
|
|
(let [result# ~expr
|
|
result# (cond-> result# (rph/wrapped? result#) deref)]
|
|
{:error nil
|
|
:result result#})
|
|
(catch Exception e#
|
|
{:error (handle-error e#)
|
|
:result nil})))
|
|
|
|
(defrecord DummyRequest [headers cookies method body-stream
|
|
remote-addr server-name server-port
|
|
scheme protocol path query ssl-client-cert]
|
|
yreq/IRequestCookies
|
|
(get-cookie [_ name]
|
|
{:value (get cookies name)})
|
|
|
|
yreq/IRequest
|
|
(get-header [_ name]
|
|
(get headers name))
|
|
(method [_] method)
|
|
(body [_] body-stream)
|
|
(path [_] path)
|
|
(query [_] query)
|
|
(server-port [_] server-port)
|
|
(server-name [_] server-name)
|
|
(remote-addr [_] remote-addr)
|
|
(ssl-client-cert [_] ssl-client-cert)
|
|
(scheme [_] scheme)
|
|
(protocol [_] protocol))
|
|
|
|
(defn make-dummy-request
|
|
"Constructs a DummyRequest from options. Called with keyword
|
|
arguments, a single options map, or no arguments; every key is
|
|
optional and missing values fall back to sensible defaults. New
|
|
fields added to DummyRequest won't break existing call sites
|
|
as long as this constructor keeps its `:or` defaults in sync.
|
|
|
|
Recognized keys:
|
|
:headers — map of header name → value
|
|
:cookies — map of cookie name → value
|
|
:method — HTTP method keyword (default :get)
|
|
:body-stream — InputStream for the body (used directly)
|
|
:body-bytes — bytes or string for the body; wrapped in a
|
|
ByteArrayInputStream if :body-stream is not
|
|
given
|
|
:remote-addr — string (default \"127.0.0.1\")
|
|
:server-name — string (default \"test\")
|
|
:server-port — long (default 0)
|
|
:scheme — keyword (default :http)
|
|
:protocol — string (default \"HTTP/1.1\")
|
|
:path — string (default \"/test\")
|
|
:query — string or nil (default nil)
|
|
:ssl-client-cert — X509Certificate or nil (default nil)"
|
|
[& {:keys [headers cookies method body-stream body-bytes
|
|
remote-addr server-name server-port scheme protocol
|
|
path query ssl-client-cert]
|
|
:or {headers {} cookies {} method :get
|
|
body-stream nil
|
|
remote-addr "127.0.0.1" server-name "test" server-port 0
|
|
scheme :http protocol "HTTP/1.1" path "/test" query nil
|
|
ssl-client-cert nil}}]
|
|
(let [body-stream (or body-stream
|
|
(when body-bytes
|
|
(java.io.ByteArrayInputStream.
|
|
(if (string? body-bytes)
|
|
(.getBytes ^String body-bytes "UTF-8")
|
|
body-bytes))))]
|
|
(->DummyRequest headers cookies method body-stream
|
|
remote-addr server-name server-port
|
|
scheme protocol path query ssl-client-cert)))
|
|
|
|
(defn- prepare-rpc-params
|
|
[data]
|
|
(let [params (reduce-kv (fn [params k v]
|
|
(if (qualified-keyword? k)
|
|
(assoc params k v)
|
|
params))
|
|
{}
|
|
(dissoc data ::type))
|
|
;; Honor a caller-supplied request map from the data metadata so
|
|
;; tests can inject headers, remote address and auth context (e.g.
|
|
;; :app.http/auth-key-id). Non-map requests (reify IRequest stubs)
|
|
;; fall back to the dummy request, which carries the body params
|
|
;; the validation wrapper reads.
|
|
supplied (-> data meta :app.http/request)
|
|
request (if (map? supplied)
|
|
(assoc supplied :params (merge (:params supplied)
|
|
(d/without-qualified data)))
|
|
(assoc (make-dummy-request)
|
|
:params (d/without-qualified data)))]
|
|
|
|
(-> params
|
|
(assoc :app.rpc/request-at (ct/now))
|
|
(with-meta {:app.http/request request}))))
|
|
|
|
(defn command!
|
|
[{:keys [::type] :as data}]
|
|
(let [[mdata method-fn] (get-in *system* [:app.rpc/methods type])]
|
|
(when-not method-fn
|
|
(ex/raise :type :assertion
|
|
:code :rpc-method-not-found
|
|
:hint (str/ffmt "rpc method '%' not found" (name type))))
|
|
|
|
(let [params (prepare-rpc-params data)]
|
|
(try-on! (method-fn params)))))
|
|
|
|
(defn management-command!
|
|
[{:keys [::type] :as data}]
|
|
(let [[_ method-fn] (get-in *system* [:app.rpc/management-methods type])]
|
|
(when-not method-fn
|
|
(ex/raise :type :assertion
|
|
:code :rpc-method-not-found
|
|
:hint (str/ffmt "management rpc method '%' not found" (name type))))
|
|
(let [params (prepare-rpc-params data)]
|
|
(try-on! (method-fn params)))))
|
|
|
|
(defn run-task!
|
|
"Execute a job handler directly (in-process, no row): the handler gets a
|
|
nil context, because there is no job to describe."
|
|
([name]
|
|
(run-task! name {}))
|
|
([name params]
|
|
(jobs/invoke (-> *system*
|
|
(assoc ::jobs/name name)
|
|
(assoc ::jobs/params params)))))
|
|
|
|
(def sql:pending-jobs
|
|
"select * from job
|
|
where status = 'new'
|
|
order by priority desc, scheduled_at")
|
|
|
|
(defn run-pending-jobs
|
|
"Execute the pending (status='new') `job` rows in-process (simulating
|
|
the dispatcher + runner for the tests). Each row gets its context and its
|
|
job-id, so heartbeats and progress reach it exactly like in the runner.
|
|
Does not touch the row status; only the handler side effects matter."
|
|
[]
|
|
(db/tx-run! *system*
|
|
(fn [{:keys [::db/conn]}]
|
|
(let [jobs-rows (db/exec! conn [sql:pending-jobs])]
|
|
(doseq [row jobs-rows]
|
|
(jobs/invoke (-> *system*
|
|
;; the row stores a string; invoke
|
|
;; takes the canonical keyword
|
|
(assoc ::jobs/name (keyword (:name row)))
|
|
(assoc ::jobs/params (:params row))
|
|
(assoc ::jobs/context (jobs/make-context row))
|
|
(assoc ::jobs/job-id (:id row)))))))))
|
|
|
|
(defn metrics-stub
|
|
"A metrics instance with no collectors, where every `run!` is a no-op."
|
|
[]
|
|
(reify metrics/IMetrics
|
|
(get-handler [_] nil)
|
|
(get-collector [_ _] nil)
|
|
(get-registry [_] nil)))
|
|
|
|
(defn init-climit
|
|
"Build a concurrency limiter component from an inline config map. The
|
|
optional second argument is the metrics instance to publish to (a
|
|
`metrics-stub` by default, where every `run!` is a no-op)."
|
|
([config]
|
|
(init-climit config (metrics-stub)))
|
|
([config metrics]
|
|
(let [file (doto (java.io.File/createTempFile "climit" ".edn")
|
|
(.deleteOnExit))]
|
|
(spit file (pr-str config))
|
|
(ig/init-key ::rpc/climit
|
|
{::climit/enabled true
|
|
::climit/config (.getAbsolutePath file)
|
|
::metrics/metrics metrics}))))
|
|
|
|
(defmacro with-climit
|
|
"Build a concurrency limiter from an inline config map, run the body and
|
|
halt it, so the republisher thread it starts never outlives the test. An
|
|
optional third binding element is the metrics instance to publish to."
|
|
[[sym config & [metrics]] & body]
|
|
`(let [~sym (init-climit ~config ~@(when metrics [metrics]))]
|
|
(try
|
|
~@body
|
|
(finally
|
|
(ig/halt-key! ::rpc/climit ~sym)))))
|
|
|
|
;; --- UTILS
|
|
|
|
(defn print-error!
|
|
[error]
|
|
(let [data (ex-data error)]
|
|
(cond
|
|
(= :spec-validation (:code data))
|
|
(println
|
|
(us/pretty-explain data))
|
|
|
|
(= :params-validation (:code data))
|
|
(println
|
|
(sm/humanize-explain (::sm/explain data)))
|
|
|
|
(= :data-validation (:code data))
|
|
(println
|
|
(sm/humanize-explain (::sm/explain data)))
|
|
|
|
(= :service-error (:type data))
|
|
(print-error! (.getCause ^Throwable error))
|
|
|
|
:else
|
|
(.printStackTrace ^Throwable error))))
|
|
|
|
(defn print-result!
|
|
[{:keys [error result]}]
|
|
(if error
|
|
(do
|
|
(println "====> START ERROR")
|
|
(print-error! error)
|
|
(println "====> END ERROR"))
|
|
(do
|
|
(println "====> START RESPONSE")
|
|
(pp/pprint result)
|
|
(println "====> END RESPONSE"))))
|
|
|
|
(defn exception?
|
|
[v]
|
|
(instance? Throwable v))
|
|
|
|
(defn ex-info?
|
|
[v]
|
|
(ex/error? v))
|
|
|
|
(defn ex-type
|
|
[e]
|
|
(:type (ex-data e)))
|
|
|
|
(defn ex-code
|
|
[e]
|
|
(:code (ex-data e)))
|
|
|
|
(defn ex-of-type?
|
|
[e type]
|
|
(let [data (ex-data e)]
|
|
(= type (:type data))))
|
|
|
|
(defn ex-of-code?
|
|
[e code]
|
|
(let [data (ex-data e)]
|
|
(= code (:code data))))
|
|
|
|
(defn ex-with-code?
|
|
[e code]
|
|
(let [data (ex-data e)]
|
|
(= code (:code data))))
|
|
|
|
(defn success?
|
|
[{:keys [result error]}]
|
|
(nil? error))
|
|
|
|
(defn tempfile
|
|
[source]
|
|
(let [rsc (io/resource source)
|
|
tmp (fs/create-tempfile :dir "/tmp/penpot" :prefix "test-")]
|
|
(io/copy (io/file rsc)
|
|
(io/file tmp))
|
|
tmp))
|
|
|
|
(defn pause
|
|
[]
|
|
(let [^java.io.Console cnsl (System/console)]
|
|
(println "[waiting RETURN]")
|
|
(.readLine cnsl)
|
|
nil))
|
|
|
|
(defn db-exec!
|
|
[sql]
|
|
(db/exec! *pool* sql))
|
|
|
|
(defn db-exec-one!
|
|
[sql]
|
|
(db/exec-one! *pool* sql))
|
|
|
|
(defn db-delete!
|
|
[& params]
|
|
(apply db/delete! *pool* params))
|
|
|
|
(defn db-update!
|
|
[& params]
|
|
(apply db/update! *pool* params))
|
|
|
|
(defn db-insert!
|
|
[& params]
|
|
(apply db/insert! *pool* params))
|
|
|
|
(defn db-delete!
|
|
[& params]
|
|
(apply db/delete! *pool* params))
|
|
|
|
(defn db-force-delete
|
|
"Deletes rows whose table is guarded by `raise_deletion_protection`,
|
|
inside a transaction that disables the guard. Test-only escape hatch:
|
|
production delete paths disable protection in their own transaction
|
|
(see `app.jobs.gc`)."
|
|
[& params]
|
|
(db/tx-run! *pool*
|
|
(fn [{:keys [::db/conn]}]
|
|
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
|
|
(apply db/delete! conn params))))
|
|
|
|
(defn db-query
|
|
[& params]
|
|
(apply db/query *pool* params))
|
|
|
|
(defn db-get
|
|
[& params]
|
|
(apply db/get* *pool* params))
|
|
|
|
(defn sleep
|
|
[ms-or-duration]
|
|
(Thread/sleep (inst-ms (ct/duration ms-or-duration))))
|
|
|
|
(defn config-get-mock
|
|
[data]
|
|
(fn
|
|
([key]
|
|
(get data key (get cf/config key)))
|
|
([key default]
|
|
(get data key (get cf/config key default)))))
|
|
|
|
(defn reset-mock!
|
|
[m]
|
|
(swap! m (fn [m]
|
|
(-> m
|
|
(assoc :called? false)
|
|
(assoc :call-count 0)
|
|
(assoc :return-list [])
|
|
(assoc :call-args nil)
|
|
(assoc :call-args-list [])))))
|
|
|
|
(defn- slurp'
|
|
[input & opts]
|
|
(let [sw (java.io.StringWriter.)]
|
|
(with-open [^java.io.Reader r (java.io.InputStreamReader. input "UTF-8")]
|
|
(io/copy r sw)
|
|
(.toString sw))))
|
|
|
|
(defn parse-sse
|
|
[content]
|
|
(let [state
|
|
(reduce (fn [{:keys [events data event id] :as state} line]
|
|
(cond
|
|
;; empty line → dispatch event if we have data
|
|
(str/blank? line)
|
|
(if (seq data)
|
|
(-> state
|
|
(update :events conj {:event (or event "message")
|
|
:data (-> (str/join "\n" data))})
|
|
(assoc :data [] :event nil))
|
|
state)
|
|
|
|
;; comment line (starts with :)
|
|
(str/starts-with? line ":")
|
|
state
|
|
|
|
:else
|
|
(let [[field raw-value] (str/split line #":" 2)
|
|
value (some-> raw-value (str/replace #"^ " ""))]
|
|
(case field
|
|
"data" (update state :data conj (or value ""))
|
|
"event" (assoc state :event value)
|
|
;; ignore retry and unknown fields
|
|
state))))
|
|
{:events [] :data [] :event nil}
|
|
(str/split content #"\r?\n"))
|
|
|
|
;; handle unterminated last event (no trailing blank line)
|
|
state (if (seq (:data state))
|
|
(update state :events conj
|
|
{:event (or (:event state) "message")
|
|
:data (str/join "\n" (:data state))})
|
|
state)]
|
|
|
|
(:events state)))
|
|
|
|
(defn consume-sse
|
|
[callback]
|
|
(let [{:keys [::yres/status ::yres/body ::yres/headers] :as response} (callback {})
|
|
output (PipedOutputStream.)
|
|
input (PipedInputStream. output)]
|
|
|
|
(try
|
|
(px/exec! :virtual #(rcp/write-body-to-stream body nil output))
|
|
(into []
|
|
(map (fn [{:keys [event data]}]
|
|
(d/vec2 (keyword event)
|
|
(tr/decode-str data))))
|
|
(parse-sse (slurp' input)))
|
|
(finally
|
|
(.close input)))))
|