mirror of
https://github.com/penpot/penpot.git
synced 2026-10-30 06:20:32 +00:00
* ✨ Run binfile import and export as durable jobs Import and export of `.penpot` files become durable jobs: two commands create them and answer at once with a job id the caller follows, while a worker of the `binfile` queue does the work. Each job keeps its own ledger (owner, params frozen at creation, result, progress history and an expiry), and the legacy commands and their SSE keep working. Why: both operations ran inside the request. A large import held it open for minutes, progress only existed while the caller kept the stream open, and a client that went away left work nobody recorded, retried or could cancel. The unified `job` substrate already dispatched, leased, retried and logged events, but it had no user-facing ledger. How: - The substrate gains the pieces a user-facing job needs: optional job-def metadata (family, resource-role), an expiry on submit, the owner in the runner context, and job resources in their own bucket, written with the profile of the job and never deduplicated. - One generic command per family: the caller names the job and sends its business params, the registry checks the family, the job-def decodes and validates, and permission and quota are checked first. - Progress taps of the core become milestones of the job: a shared stage vocabulary with self-contained counters, throttled heartbeats, and an interrupt that stops the run inside its own transaction on cancel. - Cancel reaches pending and running jobs from both modals, and closing a modal mid-run cancels the job it was following. - The export re-checks the read permission at run time and answers with the package descriptor; the import re-checks the edition permission, runs the core in a transaction so a cancellation rolls it back, and releases the consumed package and its temporary copy. AI-assisted-by: deepseek-v4.1-flash * ♻️ Handle externally-cancelled binfile jobs end to end The `cancelled` outcome of a job nobody followed no longer hangs its screens: the data layers emit an explicit terminal message for it. - The export emits `{:cancelled true}` per file and the modal paints a neutral cancelled row instead of success; a message without an artifact never reaches the download branch. - The import closes every entry with a dedicated cancelled message through the existing error rendering, so the wizard completes. - Both flows are pinned by data-layer tests, including the red state they replace. Also in this change: the progress-contract comment of the management API, early business-params validation in create-import-job (before assembling the upload), a `release-resource` helper without fabricated job ids, a note on the heartbeat write cost, and a memory cleanup. AI-assisted-by: muse-spark-1.3-contributor * ♻️ Pre-translate the cancelled import message The cancelled entry of the import wizard carried its message as a key for the UI to translate, which needed a rehash marker comment. Like its neighboring errors, it now translates eagerly in the data layer: the literal call keeps rehash clean with no marker, and the tests assert through the same call instead of the raw key. AI-assisted-by: muse-spark-1.3-contributor * ♻️ Move cancelled strings under generic labels keys The dashboard-specific cancelled key never shipped: before use it moves under `labels.*` next to the generic strings both flows already use, with Spanish translations following the established wording. AI-assisted-by: muse-spark-1.3-contributor * ✨ Add minor improvements * ♻️ Rename export job command to create-export-binfile-job Export now has one command per job type, the shape the :export-assets command needs: create-export-binfile-job freezes exactly the :export-binfile job, so :name no longer travels in the body and only :params does. Import keeps the generic envelope. submit-job reads the queue from the job-def metadata ::jobs/queue-name (falling back to :binfile), read by the command and never by the substrate, so a job-def can route its work to another queue without a change in the command. The rename reaches the frontend and the tests: the binfile export is asked for under its own name, and the exporter service keeps create-export-job. AI-assisted-by: deepseek-v4.1-flash * ✨ Polish the import and export status rows The status row of a file already carries what the file is doing, so the generic "Uploading file…"/"Downloading file…" lines are gone: the import wizard drops its own (the export one went with the jobs refactor), along with the now-unused style. In the export, every file is queued up front, even the ones whose job is created only after the previous one is over, and a file stays queued until its first milestone: a worker picking the job up no longer ends the queue. The queued text is a step smaller than the milestone. AI-assisted-by: deepseek-v4.1-flash * 🐛 Show the cancelled export and fix the import error The cancelled export was unreachable: mark-file-cancelled sets :loading false and the label lived inside the loading branch, so a cancelled file only painted a neutral notification. The terminal state now carries the label, and the export flags lose the `?` suffix (predicates keep it; a data prop is not a question). The import wizard rendered (:error entry) through tr, but every producer writes user-facing text (a hint or a translated label), never a key: it renders the text as-is now, and the dynamic-key ignores and the stale comment are gone. The total-text-limit comment no longer references the 200MiB it replaced; the value is 500MiB in develop already. AI-assisted-by: deepseek-v4.1-flash * ♻️ Reflect the real job params in the creation commands The creation commands declared their params as an open empty map, so the RPC contract and the generated docs said nothing about them. Each command now imports the schema from the job namespace (`export-binfile/schema:params`, `import-binfile/schema:create-params`), and the RPC validates the business params before the command runs. The job-def still owns the params and re-validates the assembled ones at run time. The commands no longer decode the params again: the RPC did it. Import joins export as one command per job type: `create-import-job` becomes `create-import-binfile-job`, its body no longer carries `:name` and the job-def is resolved by name like export's. Its creation schema keeps the version optional, because the command reads it from the package header when the caller does not say it, and fills the manifest metadata kept for audit. A version out of range is now refused by the schema (`:params-validation`) instead of the command's own `:unsupported-version` check, which is gone. AI-assisted-by: deepseek-v4.1-flash * 🐛 Stop the test system from running job runners The test system is main/system-config plus main/worker-config with a few components dissoc'ed. The runners of default, webhook and cron were listed by hand; the binfile runner added with the durable binfile jobs was not, so a real penpot/job-runner/binfile/0 thread ran during the whole suite. That runner races the tests that drive the loop by hand (run-batch plus run-worker-loop): it takes the job the test just dispatched and completes it, and the test then reads a state it did not produce. That is the reported flake of binfile-jobs-integration-test, whose middle assertion waits for a runner of another queue to not take the job. It only reproduced in CI: in the devenv PENPOT_TENANT makes the tenant baked into main/worker-config differ from the one the test builds, so the two used different queue keys locally. Drop every [<profile> :app.worker/runner] by key shape instead of listing the known queues, so a new queue cannot bring the race back. AI-assisted-by: deepseek-v4.1-flash * ✨ Upload the package one chunk at a time and as a percentage The upload milestone counts chunks, not units of work, so the row wrote "Uploading the package 3/9" over a file the user had uploaded once: it read as if nine packages were on their way. Write the stage as a percentage of the file instead ("Uploading file… (33%)"), and make the English text of the stage say file, not package. The chunks also go one at a time now (concat-all instead of merge-all with two in flight), so the percentage moves in a straight line instead of jumping. upload-blob-chunked is the generic uploader, so media and font uploads become sequential too. AI-assisted-by: deepseek-v4.1-flash * 🌐 Complete the Spanish catalogue es.po was 25 keys short of en.po: the 15 that the durable binfile jobs introduced (14 jobs.progress.stage.* and labels.queued) plus 10 gaps that predate them (errors.connection-error, errors.save-retrying, the find shortcuts, workspace.header.retrying, workspace.tokens.stroke-width and the mcp session labels). sync -l es then sorts the entries, syncs the #: comments from en and drops the 7 dashboard.import.progress.* keys en no longer has. The msgid sets of en and es are now identical (0 missing, 0 extra). AI-assisted-by: deepseek-v4.1-flash * ♻️ Move the job status keys into the jobs namespace The three status words the durable import and export rows render were filed under labels.*, next to the generic labels bucket, while their progress stages live under jobs.progress.stage.*: the strings of one feature sat in two places. Rename them so the whole job vocabulary is one namespace: labels.queued -> jobs.queued labels.export-cancelled -> jobs.export-cancelled labels.import-cancelled -> jobs.import-cancelled No other locale has these keys yet, so the rename costs no translation. The convention (a key names the feature that renders it; labels.* holds the generic reusable words) is written down in the frontend/translations memory. AI-assisted-by: deepseek-v4.1-flash * 🔥 Remove the translation keys nothing references Six keys of en.po (and of es.po, which now mirrors it) have no (tr ...) call site left in frontend/src or common/src, and no literal reference either: labels.uploading-file a duplicate of jobs.progress.stage.upload since the upload stage says "Uploading file…" labels.downloading-file dead since the durable jobs replaced the old import and export progress rows inspect.attributes.stroke.alignment.center inspect.attributes.stroke.alignment.inner inspect.attributes.stroke.alignment.outer workspace.toolbar.mcp-connect-here The first two are leftovers of the durable binfile jobs, the other four predate them. Both catalogues keep an identical msgid set afterwards. AI-assisted-by: deepseek-v4.1-flash
755 lines
26 KiB
Clojure
755 lines
26 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.migrations]
|
|
[app.msgbus :as-alias mbus]
|
|
[app.rpc :as-alias rpc]
|
|
[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 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)))))))))
|
|
|
|
;; --- 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)))))
|