diff --git a/.serena/memories/backend/core.md b/.serena/memories/backend/core.md index aa3d0975e5..ead956fe10 100644 --- a/.serena/memories/backend/core.md +++ b/.serena/memories/backend/core.md @@ -4,7 +4,7 @@ Backend: JVM Clojure; Integrant; PostgreSQL; Redis/Valkey; RPC; HTTP; storage; m ## Focused memories -- Cross-cutting backend subtleties (RPC, DB, workers, cron, HTTP/sessions, storage, file data): `mem:backend/subtleties` +- Cross-cutting backend subtleties (RPC, DB, workers, cron, CLIMIT, HTTP/sessions, storage, file data): `mem:backend/subtleties` - Storage abstraction, logical buckets, object lifecycle, deduplication, access, and garbage collection: `mem:backend/storage`. - Embedded Ladybug graph experiment, projection, incremental sync, console, and risks: `mem:backend/graph-experiment` - Session lifetime config, token `:exp`, and idle/absolute GC: `mem:backend/session-expiration`. @@ -24,6 +24,7 @@ Backend: JVM Clojure; Integrant; PostgreSQL; Redis/Valkey; RPC; HTTP; storage; m - `app.worker`: task execution/cron plumbing. - `app.main`: Integrant system map and component wiring. - `app.config`: `PENPOT_*` env config and feature flags. +- `app.health`: per-process availability flag; `/readyz` answers 503 while offline. Flipped from `app.srepl.main` (`set-offline` / `set-online`). - `app.srepl.*`: development REPL helpers for manual backend operations (data inspection, migration helpers, one-off admin tasks). - `app.nitrate`, `app.rpc.commands.nitrate`, and `app.rpc.management.nitrate`: external Nitrate subscription/organization integration, gated by the `:nitrate` feature flag and shared-key HTTP calls. @@ -88,7 +89,7 @@ Fixtures can populate local data for manual testing/perf work. From the backend * **Type Hinting:** Use explicit JVM type hints (e.g. `^String`, `^long`) in performance-critical paths to avoid reflection overhead. * **Batch inserts:** Use `db/insert-many!` for bulk row inserts — generates a single SQL with multiple parameter tuples. Avoid on very large datasets (SQL length / parameter count limits). -* **Server-side cursors:** Use `db/plan` (fetch-size 1000, forward-only, read-only) or `db/cursor` for large result sets. Never fetch large collections into memory at once. +* **Server-side cursors:** Use `db/plan` (fetch-size 1000, forward-only, read-only) for large result sets. Never fetch large collections into memory at once. `db/plan` is an `IReduceInit`: `reduce`/`transduce` over it (`sequence` does not work on it), and with `partition-all` the transducer's completing arity is what flushes the last partial chunk. A plan row is a **view over the open result set**, valid only inside the reducing function: read the columns you need right there — buffering rows to read them later (a `partition-all` buffer, a lazy seq) silently yields nil columns. `db/cursor` (manual `DECLARE`/`FETCH`) is a leftover with no callers left. * **Transaction discipline:** Use `tx-run!` for writes (opens a transaction), `run!` for reads (single connection, no transaction). Set `:read-only` on `tx-run!` when applicable to let PostgreSQL optimize. ## Lint and Format diff --git a/.serena/memories/backend/storage.md b/.serena/memories/backend/storage.md index 4a48cd8c71..3d978642df 100644 --- a/.serena/memories/backend/storage.md +++ b/.serena/memories/backend/storage.md @@ -25,9 +25,9 @@ - Existing object values can remain readable until physical deletion. - `:expired-at` blocks reads after the expiration time. - `del-object!` sets `deleted_at` on live rows only (`deleted_at IS NULL`): a repeated call returns `false`. It does not remove backend content. -- `storage-gc-deleted` removes the database row and backend content after the deletion delay. +- `storage-gc-deleted` removes the database row and backend content after the deletion delay, streaming the pending rows with `db/plan` inside a read-only transaction and deleting them in chunks of 25, each chunk in its own transaction: a chunk that fails (for example, an object a foreign key still references) is logged and skipped instead of aborting the run. A physical-deletion failure inside a chunk defers its rows one day (`deletion_attempts + 1`) and gives up after 7 attempts, accepting the orphan blob; chunk mappings (`upload_session_chunk`) are removed before the `storage_object` rows (NO ACTION foreign keys). - `storage-gc-touched` finds references before it sets `deleted_at`. -- `objects-gc` removes deleted domain rows and touches their storage object IDs. +- `objects-gc` removes deleted domain rows and touches their storage object IDs. Each proc streams its pending keys with `db/plan` inside a read-only transaction and deletes them in chunks, each chunk in its own transaction with `FOR UPDATE SKIP LOCKED`: a chunk that fails is logged and skipped instead of aborting the run. - Use `::db/reuse-conn true` with `sto/resolve` inside a database transaction. ## Connection Reuse Details diff --git a/.serena/memories/backend/subtleties.md b/.serena/memories/backend/subtleties.md index ad6c4321ae..bb4ac77466 100644 --- a/.serena/memories/backend/subtleties.md +++ b/.serena/memories/backend/subtleties.md @@ -10,6 +10,17 @@ - Params schemas are open by default, so undeclared client keys reach the handler unless the map is `:closed true`. Creation commands (`create-file`, `create-project`, `create-team`, `create-team-with-invitations`, `upload-file-media-object`, `create-file-media-object-from-url`, `assemble-file-media-object`) use closed schemas: a client-provided `:id` fails with `:params-validation`. Their internal creation functions still accept an optional explicit `:id` for imports, duplicates and deterministic test fixtures. - Nil RPC bodies become HTTP 204 unless explicit status metadata is present. Stream bodies default to `application/octet-stream` when no content type is set. +## Concurrency limiter (CLIMIT) + +- `::climit/id` is either a plain keyword, which gives one shared limiter per process, or the vector form `[[id key-fn]]`, which gives one limiter per key. `climit/wrap` takes the key only from that positional `key-fn` (`climit/get-limits` maps a plain keyword to a single-element vector), so `::climit/key-fn` is metadata that nothing reads: a command declaring `::climit/id :x/by-profile` next to it ends up with a single shared limiter, and the missing key is visible in the `app.rpc.climit` log lines, whose `id` carries no key suffix. That is what happened to `push-audit-events`, the last user of the dead metadata, from `a5c6d78ee5` (2024-01-27, "fix some fundamental bugs on climit module", which moved the key to the vector form without updating it) until it was fixed; nothing declares `::climit/key-fn` any more, so keep using the vector form for anything that must be per profile. +- A gauge written by whichever limiter of a name ran last cannot show a queue: every per-profile limiter of the name collapses into one series, so a healthy profile writing 0 overwrites the 15 of the one that is queueing (measured in production: 4 of 1441 samples). `penpot_rpc_climit_waiting` replaces it and is accumulated: one counter per name and instance, up when a call starts waiting for a permit, down when it stops, so a call that enters and never leaves keeps the value above zero for ever. `penpot_rpc_climit_rejected_total` counts rejections by name and `reason`: `queue-full` when the error carries `:size`, `timeout` when it carries `:timeout` (both carry `:code :capacity-limit-reached`, so the timeout field is the discriminator). The two gauges that could not tell the truth (`penpot_rpc_climit_queue`, `penpot_rpc_climit_permits`) were deleted, and so was `penpot_http_worker_busy_threads`, which reads 0 on an instance with 72 blocked threads: `penpot_http_worker_pool_size` is the signal for retained threads. A stuck limiter also shows up in `penpot_rpc_climit_timing_count` (the acquired path), which is a counter: compare the same limiter name across instances and the stuck one reads 0 acquisitions while its peer reads thousands. In thread dumps it reads as threads parked in `psm/acquire` whose CPU time does not grow between two dumps, on an instance that is otherwise idle. +- The waiting counters are a field of the `ConcurrencyLimiter` component (a `ConcurrentHashMap` of name to `AtomicLong`), so they start at zero, die with the component, and the sampler that closes over that map republishes only its own names every 15 s; the sampler stops with the component in `halt-key!`. `impl-invoke` pairs one decrement with one increment through a per-call flag: the flag turns a second call into a no-op and the `finally` guarantees that there is one. The increment sits inside the `try` and the decrement lives only in the acquired callback and the `finally`, so a handler that throws, a rejection and a throwable from the publishing path all leave the count where it was and the thread without the limiter marked as held (a leftover mark would skip that limiter for that key for ever). Concurrent `inc`/`dec` publications of two threads can land out of order and the value can read low for a moment; the republish corrects it. +- The `app.rpc.climit` log lines carry `queue`, `queue-max`, `permits`, `elapsed`, `code` and `reason`, and their `id` carries the key (`name/`). That is the only place where the profile behind a queue is visible: a pile-up is chased there, on demand, not in the metrics. The `queue` of the line is the calls inside the limiter minus its permits, so it reads 0 for a lone caller that times out: that line goes out at TRACE instead of WARN, and the rejection count has to come from the metric. +- Nothing in the limiter path has a timeout unless the config sets one, and `psm/acquire` then calls `Semaphore.acquire`, which parks the calling thread forever. A parked thread still counts as in-system for every outer limiter of its chain, so the outermost one (the method's own by-profile limiter) stops granting permits and answers 429 to everything. A limiter without `:queue` gets an unlimited queue and therefore never rejects: its pile-up is silent, with no 429 and no log line except the WARN `enqueued`/`acquired` lines of the keyed id. +- Deadlock shape between a command's own limits and the root ones (fixed): a command declaring its own limits held `process-image/by-profile` before `root/by-profile`, while a command with no limits of its own takes the roots first and then re-enters with the same keyed limits from inside its handler (`create-file-media-object-from-url`, `upload-photo`) and waits for them holding a root permit. Two calls of one profile then held the same two limiters inverted and parked for good: 69 threads at 0 CPU, an audit limiter with 0 acquisitions in 24h and 100% 429s, on an instance that never served a 204. +- `climit/wrap` now appends the root limiters after the command's own, so `root/global`/`root/by-profile` end up outermost and every path meets them first; the nested `climit/invoke!` chains carry only the command's own limits and run inside them, which puts both paths in the same order. `impl-invoke` also keeps, per thread, the set of limiters that thread is inside of and runs the handler inline when a call asks for one it already holds, instead of queueing behind itself. That check relies on `pbh/invoke!` running the handler on the calling thread; the mark is removed in a `finally`. Commands declare the by-profile limit before the global one, which makes it the outermost of the pair: keep that declaration order, the reverse one would put two paths back in inverted order. The two nested call sites (`create-file-media-object-from-url`, `upload-photo`) still share `process-image` with the enclosing call instead of getting a limiter of their own, so the comment there about keeping the download out of that limit no longer holds. +- The shipped `backend/resources/climit.edn` sets a timeout on every limiter, 60s for operations that can be slow and 30s otherwise, with a test that fails when an entry ships without one, and `init-key` logs a WARN for every entry without a timeout. The production file lives outside the repository: mirror it there, and remember that a parked thread only goes away with a restart or a deploy. + ## DB helpers - Most `app.db` helpers accept a pool, connection, or map containing `::db/pool` / `::db/conn`; preserve that convention in shared code. @@ -41,8 +52,9 @@ ## HTTP server self-metrics - `app.http` enables Undertow connection statistics via the yetti option `:server/statistics` (requires yetti ≥ v11.11, which exposes it; before the patch `ListenerInfo#getConnectorStatistics` returned `nil`). -- A daemon sampler built on `promesa.exec` (`px/scheduled-executor` plus a self-rescheduling `px/schedule` chain, so a failing sample never cancels the next one; 15 s, started with the server in `ig/init-key` and stopped with `px/shutdown-now` in `halt-key!`) publishes worker and listener state: `penpot_http_worker_queue_size`, `busy_threads`, `pool_size`, `max_pool_size`, `penpot_http_connector_active_connections`, `requests_total`, `errors_total`. Definitions live in `app.main/default-metrics`. -- The xnio worker MXBean can return transient `-1` (e.g. busy-thread count); negative samples are discarded (gauge keeps its previous value). Undertow exposes absolute request/error totals, so the sampler keeps a watermark atom and publishes deltas; a counter reset (decreasing totals) skips the negative delta and moves the watermark forward. +- `app.metrics/create-sampler` holds the sampler shape: a single daemon `px/scheduled-executor` thread with a self-rescheduling `px/schedule` chain, so a failing sample never cancels the next one; the owner starts it in `ig/init-key` and stops it with `px/shutdown-now` in its `halt-key!`. Http and CLIMIT both sample every 15 s. +- `app.http` uses it to publish worker and listener state: `penpot_http_worker_queue_size`, `penpot_http_worker_pool_size`, `penpot_http_worker_max_pool_size`, `penpot_http_connector_active_connections`, `penpot_http_connector_requests_total`, `penpot_http_connector_errors_total`. Definitions live in `app.main/default-metrics`. The xnio busy-thread count is not published: it reads 0 with threads blocked inside a limiter, which is why it was deleted. +- The xnio worker MXBean can return transient `-1` (e.g. on the queue or the pool size); negative samples are discarded (gauge keeps its previous value). Undertow exposes absolute request/error totals, so the sampler keeps a watermark atom and publishes deltas; a counter reset (decreasing totals) skips the negative delta and moves the watermark forward. - The `process_*` families (`process_open_fds`, `process_max_fds`, `process_cpu_seconds_total`, …) come from the prometheus client `StandardExports`, registered by `app.metrics/create-registry`. They read the OS MXBean reflectively and need the `jdk.management` module: on a pruned `jlink` JRE the MXBean is `sun.management.BaseOperatingSystemImpl`, the getters throw `NoSuchMethodException` and `StandardExports#collect` swallows it, so those families silently vanish from `/metrics`. `docker/images/Dockerfile.backend` keeps `jdk.management` in the `--add-modules` list, and `backend-tests.metrics-test` pins the contract. ## Metrics recording diff --git a/.serena/memories/backend/testing.md b/.serena/memories/backend/testing.md index 256a330fa1..3cec805699 100644 --- a/.serena/memories/backend/testing.md +++ b/.serena/memories/backend/testing.md @@ -10,4 +10,5 @@ JVM `clojure.test` (kaocha runner) under `backend/test/backend_tests/`. - Isolated run: `clojure -M:dev:test --focus backend-tests.my-ns-test` for a specific test namespace, or `clojure -M:dev:test --focus backend-tests.my-ns-test/my-test-var` for a specific test var. - Regression run: `clojure -M:dev:test` to ensure no regressions in related functional areas. - If you need to filter output, tee to a temp file first: `clojure -M:dev:test 2>&1 | tee /tmp/penpot-test-output.txt`. -- RPC test helpers `command!`/`management-command!` split the data map: qualified keys become server params, unqualified keys become request body params. To inject request-level context (headers, `:app.http/auth-key-id`, ip), pass a map under `:app.http/request` metadata; non-map `IRequest` stubs fall back to a dummy request. \ No newline at end of file +- RPC test helpers `command!`/`management-command!` split the data map: qualified keys become server params, unqualified keys become request body params. To inject request-level context (headers, `:app.http/auth-key-id`, ip), pass a map under `:app.http/request` metadata; non-map `IRequest` stubs fall back to a dummy request. +- `backend-tests.helpers` has `metrics-stub` (a metrics instance with no collectors, where every `run!` is a no-op), `init-climit` (a concurrency limiter built from an inline config map, with an optional second argument for the metrics instance to publish to) and `with-climit`, the macro that builds one, runs the body and halts it. `init-climit` starts the republisher daemon thread, so a test that builds a limiter without halting it leaks that thread for the rest of the JVM run: use `with-climit`. Log lines are capturable with `add-watch` on `app.common.logging/log-record` (it holds the last record; the watcher sees every one, but only of the levels the logger has enabled: a line the app writes at TRACE never gets there). diff --git a/.serena/memories/common/uri.md b/.serena/memories/common/uri.md new file mode 100644 index 0000000000..9648499409 --- /dev/null +++ b/.serena/memories/common/uri.md @@ -0,0 +1,13 @@ +# Common URI helpers + +`app.common.uri` wraps `lambdaisland.uri` and re-exports `join`, `parse`, `query-encode`, `percent-encode` and `uri?` with `dm/export`. + +## `join` resolves references, it does NOT concatenate paths + +- `lambdaisland.uri/join` implements RFC 3986 reference resolution, not path concatenation: a relative reference that does not start with `/` replaces everything after the last `/` of the path it is resolved against. Joining several segments resolves them successively, so each segment replaces the last segment of the previous result. +- `(join "https://h/" "api/teams/" "" "users/" "")` returns `https://h/api/teams/users/`, not `.../api/teams//users/`: `"users/"` replaced `""`. `(apply join base segments)` behaves the same. +- `ensure-path-slash` normalizes only the BASE to end with `/`; it does not touch the segments, so a base ending in `/` is not enough for a multi-segment append. +- To append several segments: either join them into a single relative path first (dropping empty segments and collapsing slashes), or make every non-final segment end with `/`, including the dynamic ids. Keep that normalization in the shared URL builder, not in each call site. +- A segment starting with `/` resolves against the host root and silently drops the base subpath; reject it. +- Frontend `app.config` normalizes the base (`normalize-uri`) and relies on callers passing trailing-slash segments by convention (`resolve-file-media` joins `"assets/by-file-media-id/"` then `"/thumbnail"`); it does not normalize segments. +- Backend shared builders are `app.config/join-uri` and `app.config/get-public-uri`. A past refactor moved Nitrate's per-request helper onto them without the segment normalization and broke every multi-segment Nitrate URL that passes `"api/teams/" team-id "users/" profile-id`. diff --git a/.serena/memories/prod-infra/core.md b/.serena/memories/prod-infra/core.md index 8d6312562e..e38a56c45b 100644 --- a/.serena/memories/prod-infra/core.md +++ b/.serena/memories/prod-infra/core.md @@ -27,8 +27,23 @@ Two known race patterns survive multi-backend operation: Penpot in production lives with both: horizontal-scale deployments accept "exactly-once" as "essentially-once for idempotent operations." Devenv parallel instances handle it by running workers only on ws0 (see `mem:devenv/core`). +## Draining one instance + +Each backend has a per-process availability flag (`app.health`, a global atom). While offline, `/readyz` answers `503 OFFLINE` without querying the database, so the load balancer removes that instance from rotation while requests in flight still finish. Operator surface: `app.srepl.main/set-offline` / `set-online`; a restart comes back online. In-flight worker tasks are safe: tasks claimed as `scheduled` return to `new` after 5 minutes via `sql:reschedule-lost` and another instance picks them up. + +## Touching production data + +Production runs the deployed toolbox, not the devenv one: + +- **No psql meta-commands there.** `scripts/psql` and `\set`, `\if`, `\copy` do not exist in production, so a data script must be **plain SQL**, copy-pasteable into any client. +- **Start from the ids, not from an inventory.** The ids come from the error or the logs. Unbounded queries over tables with tens of millions of rows (`storage_object`, `file_media_object`) do not finish in a reasonable time; bounded to an id list they are index lookups. +- **One query per reference column.** Two columns in one `IN (col_a, col_b)` lose the index and scan the whole table; split them. +- The read-only replica cuts long queries: see `mem:prod-infra/grafana`. + ## See also - Devenv composition and the ws0-only worker placement: `mem:devenv/core`. - Storage backend resolution, dedup, bucket behavior, object lifecycle, and file-data lifecycle: `mem:backend/storage`. - Storage operation metrics (S3 API calls, logical ops, dedup, asset requests) and the logical-bucket vs physical-target distinction: `mem:backend/storage` (Metrics section). +- Storage operation metrics (S3 API calls, logical ops, dedup, asset requests) and the logical-bucket vs physical-target distinction: `mem:backend/storage` (Metrics section). +- Grafana (datasource ids and how to use them, main dashboard, panel conventions and gotchas): `mem:prod-infra/grafana`. diff --git a/.serena/memories/prod-infra/grafana.md b/.serena/memories/prod-infra/grafana.md new file mode 100644 index 0000000000..fbc40ec6e5 --- /dev/null +++ b/.serena/memories/prod-infra/grafana.md @@ -0,0 +1,42 @@ +# Grafana + +Private instance with Penpot metrics and logs. Dashboards are edited through the Grafana API (MCP tools); there is no dashboards-as-code for them. + +Keep this memory free of internal names: no host names, no deployed versions, no topology. The datasource ids and the label conventions are the useful technical part. + +## Datasources + +- Metrics — **Prometheus**, uid `xkRmyFBGk`. PromQL. Metric families: `penpot_*` (RPC, task timings, CLIMIT, HTTP, websocket, storage), `hikaricp_*`, `jvm_*` and `process_*` on the backend (`job="app"`); `pg_*` from the Postgres exporter (`job="postgres"`); `redis_*` from the Redis exporter (`job="redis"`); `node_*` and `container_*` from node-exporter and cAdvisor. Backend histograms are in **milliseconds**. +- Logs — **Loki**, uid `h3CGKhEMk`. LogQL, and filter by the structured metadata `logger`/`level` (`{job="penpot"} | logger="..." | level="ERROR"`). Signals that only exist as logs: the profile behind a CLIMIT queue (`logger="app.rpc.climit"`, whose `id` carries the key). CLIMIT rejections have their own counters (`penpot_rpc_climit_rejected_total`, by `name` and `reason`), and their `hint="rejected"` line goes out at WARN only when something stays queued, so counting the lines is not counting the rejections. +- SQL — **Postgres**, uid `y8ea9tfMk`. Panels need `rawQuery: true`, `editorMode: "code"` and `format: "table"`. The `task` table is the only truth about the queue depth. It is a **read-only replica**: it rejects any write, `CREATE TEMP TABLE` included, so queries through it must be plain `SELECT`s. It also cuts long-running queries (the MCP path has a short timeout), so bound them (e.g. a list of ids); an empty answer there is not proof that there is no data. +- **Postgres (telemetry)**, uid `9YAUuM_Gz`. +- `$__rate_interval` and `$__interval` are substituted by Grafana; use them instead of fixed windows in graphs. + +## Main dashboard + +- `Production status`, uid `penpot-production-status`. Sections: general state and deploy, RPC and CLIMIT, PostgreSQL and pool, Redis/msgbus, tasks, JVM/process. Variables `$env` and `$host` (custom), no auto refresh. +- Per-host investigation dashboards are separate, and the alert rules deeplink into them. + +## Conventions + +- Filter with `instance=~"$host.$env..*"`. To know which instances serve, count the ones reporting JVM metrics; `up{job="app"}` is not reliable (it can report 1 while the endpoint answers an empty body). +- Layout: a band of number-only panels at the top of each section, wider data panels below, tables tall enough to show every row, legend on the **right** sorted by last value descending (`sortBy: "Last *"`, `sortDesc: true`). +- Panels comparing used against total need `defaults.min = 0`, else the automatic axis exaggerates the difference. +- Counters per method or task name read better as `increase(...[1h])` than `rate(...)`, with `decimals: 0`. +- Cron "did it run" comes from the task metrics, not from the cron registry table (it keeps rows from old versions). +- Dashboard thresholds must match the alert rule thresholds. + +## Gotchas + +- PromQL literal dots need `\\.`; simpler to use `[.]` or a plain dot. +- The panel-level `datasource` must match its targets'. A SQL table declared as Prometheus renders empty even though the query returns rows. +- Shortening a host in a legend needs a short label in the query: `renameByRegex` renames the field name, but with `legendFormat` set the legend text comes from the datasource. + - Prometheus: `label_replace(, "host", "$1", "instance", "([^.]+)[.][^.]+.*")` plus `legendFormat: "... {{host}}"`. + - Loki metric query: `| label_format host="{{ regexReplaceAll "[.][^.]*[.][^.]*[.][^.]*$" .instance "" }}"` plus `legendFormat: "{{host}}"`. Quotes inside the template must be escaped as `\"`, or LogQL closes the string early (`not a valid duration string`). +- Tables from a Prometheus raw selector carry a `__name__` column; hide it with `organize`. +- Saving through the API normalizes the dashboard (rows may be flattened, `y` recomputed): submit the native form (rows with `panels: []`, panels top-level, contiguous `y`). +- Panel images cannot be rendered (no image renderer installed) and there is no browser here: verify a dashboard by running its queries with the variables substituted. +- Signals that exist only as logs are counted with Loki, and the count is then cross-checked against the nginx access log for the same window and the same status code (`job="frontend"`, e.g. a `429`): two independent sources must agree before a number is trusted. +- The app writes its own logs at WARN only when something is left queued behind the call and at TRACE otherwise, so production Loki holds just the under-pressure lines: a count of `hint="enqueued"` or `hint="acquired"` is not the number of calls, and neither is a count of `hint="rejected"` lines, because a rejection that leaves the queue empty (a lone caller that times out) is written at TRACE. The rejection counters are the real number. +- The MCP Prometheus tool can answer empty for every query, `up` included, while the datasource itself is fine: an empty result from it is not proof that a panel has no data, and blaming the datasource for it is wrong. Run PromQL by hand with `grafana_api_request` against `/api/datasources/uid//resources/api/v1/query?query=...` (or `POST /api/ds/query`, the path dashboards use), and check when a series is expected but the tool says nothing. +- **Check `list_dashboard_versions` before writing.** The user edits dashboards by hand and a full-JSON overwrite silently reverts that work; prefer `operations` patches per panel. diff --git a/CHANGES.md b/CHANGES.md index c464307e9d..2d83b456f3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -120,6 +120,20 @@ - Delete selected path handles with Backspace or Delete [#11858](https://github.com/penpot/penpot/issues/11858) (PR: [#11896](https://github.com/penpot/penpot/pull/11896)) - Use the tooltip component in the token pill info [#11886](https://github.com/penpot/penpot/issues/11886) (PR: [#11900](https://github.com/penpot/penpot/pull/11900)) - Hide the duplicate cursor when alt-dragging a shape that cannot be duplicated (by @0xTHAC0) [#11905](https://github.com/penpot/penpot/issues/11905) (PR: [#11195](https://github.com/penpot/penpot/pull/11195)) +## 2.18.4 + +### :bug: Bugs fixed + +- Fix storage GC deleting nothing when one pending object is still referenced [#12276](https://github.com/penpot/penpot/issues/12276) (PR: [#12269](https://github.com/penpot/penpot/pull/12269)) +- Fix objects GC stopping file deletion when one file still has a child row [#12277](https://github.com/penpot/penpot/issues/12277) (PR: [#12269](https://github.com/penpot/penpot/pull/12269)) +- Fix file restore leaving its storage objects marked for deletion [#12278](https://github.com/penpot/penpot/issues/12278) (PR: [#12269](https://github.com/penpot/penpot/pull/12269)) +- Fix backend workers staying parked forever when nested calls take the same concurrency limits [#12279](https://github.com/penpot/penpot/issues/12279) (PR: [#12269](https://github.com/penpot/penpot/pull/12269)) +- Fix one profile's activity blocking the audit events of every other profile [#12280](https://github.com/penpot/penpot/issues/12280) (PR: [#12269](https://github.com/penpot/penpot/pull/12269)) + +### :sparkles: New features & Enhancements + +- Add a graceful instance drain through the /readyz endpoint [#12281](https://github.com/penpot/penpot/issues/12281) (PR: [#12269](https://github.com/penpot/penpot/pull/12269)) +- Add an accumulated queue gauge to the CLIMIT metrics [#12282](https://github.com/penpot/penpot/issues/12282) (PR: [#12269](https://github.com/penpot/penpot/pull/12269)) ## 2.18.3 diff --git a/backend/resources/climit.edn b/backend/resources/climit.edn index c109b2afdb..9b585edabc 100644 --- a/backend/resources/climit.edn +++ b/backend/resources/climit.edn @@ -1,60 +1,71 @@ ;; Example climit.edn file ;; Required: permits -;; Optional: queue, ommited means Integer/MAX_VALUE -;; Optional: timeout, ommited means no timeout -;; Note: queue and timeout are excluding -{:update-file/global {:permits 20} +;; Optional: queue, omitted means Integer/MAX_VALUE (unbounded) +;; Optional: timeout in milliseconds, omitted means the thread waits for a +;; permit forever, and a saturated limiter parks it for good. Values below: +;; 60s for operations that can be slow (file updates, images, fonts, thumbnails, +;; snapshots, imports) and 30s for the rest. +;; Note: a queue bounds how many waiters pile up, a timeout bounds how long one +;; waiter waits. Every entry sets a timeout; the by-profile ones also set a +;; queue, which is where a pile-up hurts. +{:update-file/global + {:permits 20 :timeout 60000} :update-file/by-profile - {:permits 1 :queue 5} + {:permits 1 :queue 5 :timeout 60000} - :process-font/global {:permits 4} - :process-font/by-profile {:permits 1} + :process-font/global + {:permits 4 :timeout 60000} + :process-font/by-profile + {:permits 1 :timeout 60000} - :process-image/global {:permits 8} - :process-image/by-profile {:permits 1} + :process-image/global + {:permits 8 :timeout 60000} + :process-image/by-profile + {:permits 1 :timeout 60000} - :auth/global {:permits 8} + :auth/global + {:permits 8 :timeout 30000} :root/global - {:permits 40} + {:permits 40 :timeout 30000} :root/by-profile {:permits 10 :queue 30 :timeout 30000} :file-thumbnail-ops/global - {:permits 20} + {:permits 20 :timeout 60000} :file-thumbnail-ops/by-profile - {:permits 2} + {:permits 2 :timeout 60000} :submit-audit-events/by-profile - {:permits 1 :queue 3} + {:permits 1 :queue 3 :timeout 30000} :restore-file-snapshot/global - {:permits 3} + {:permits 3 :timeout 60000} :restore-file-snapshot/by-profile {:permits 1 :queue 2 :timeout 60000} :create-file-snapshot/global - {:permits 3} + {:permits 3 :timeout 60000} :create-file-snapshot/by-profile {:permits 1 :queue 2 :timeout 60000} :send-user-feedback/global - {:permits 4} + {:permits 4 :timeout 30000} :send-user-feedback/by-profile - {:permits 1 :queue 3} + {:permits 1 :queue 3 :timeout 30000} :import-binfile/global - {:permits 4} + {:permits 4 :timeout 60000} :import-binfile/by-profile - {:permits 1 :queue 2} + {:permits 1 :queue 2 :timeout 60000} :profile-plugin-ops/global - {:permits 4} + {:permits 4 :timeout 30000} :profile-plugin-ops/by-profile - {:permits 1 :queue 2}} + {:permits 1 :queue 2 :timeout 30000}} diff --git a/backend/src/app/config.clj b/backend/src/app/config.clj index c4f097c373..8939dbfc48 100644 --- a/backend/src/app/config.clj +++ b/backend/src/app/config.clj @@ -187,7 +187,6 @@ [:audit-log-http-handler-concurrency {:optional true} ::sm/int] [:default-executor-parallelism {:optional true} ::sm/int] ;; REVIEW - [:scheduled-executor-parallelism {:optional true} ::sm/int] ;; REVIEW [:worker-default-parallelism {:optional true} ::sm/int] [:worker-webhook-parallelism {:optional true} ::sm/int] diff --git a/backend/src/app/health.clj b/backend/src/app/health.clj new file mode 100644 index 0000000000..aa414a6348 --- /dev/null +++ b/backend/src/app/health.clj @@ -0,0 +1,45 @@ +;; 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 INC Sucursal en España SL + +(ns app.health + "Instance availability state. + + A single flag tells whether this backend instance is willing to receive + traffic. The readiness endpoint (`/readyz`) reports the instance as + unavailable while the flag is off, so the load balancer removes it from + rotation. Requests already in flight are still served. + + The state is a plain global atom and not an Integrant component because + it must also exist on a bare REPL session, which is where the srepl + helpers change it." + (:require + [app.common.logging :as l])) + +(defonce state + (atom true)) + +(defn online? + "Returns true when this instance is able to receive traffic." + [] + @state) + +(defn set-offline + "Marks the instance as offline. The `/readyz` endpoint answers 503 until + `set-online` is called again. + + Use it to drain the instance from the load balancer before a restart: + the load balancer stops sending new requests and the requests in flight + finish on their own." + [] + (l/inf :hint "instance set offline" :endpoint "/readyz") + (swap! state (constantly false))) + +(defn set-online + "Marks the instance as online again, so the load balancer sends it + traffic." + [] + (l/inf :hint "instance set online" :endpoint "/readyz") + (swap! state (constantly true))) diff --git a/backend/src/app/http.clj b/backend/src/app/http.clj index fa0e04e46c..30efa426e4 100644 --- a/backend/src/app/http.clj +++ b/backend/src/app/http.clj @@ -55,21 +55,19 @@ (defn sample-worker-metrics "Publishes the current state of the xnio worker thread pool (the - request dispatch queue and its threads) as gauges." + request dispatch queue and its threads) as gauges. The pool size is the + signal to watch: the busy thread count of this MXBean stays at zero with + threads blocked inside a concurrency limiter, so it is not published." [metrics ^XnioWorkerMXBean mxbean] (let [queue-size (.getWorkerQueueSize mxbean) - busy-count (.getBusyWorkerThreadCount mxbean) pool-size (.getWorkerPoolSize mxbean) max-size (.getMaxWorkerPoolSize mxbean)] - ;; negative values are missing measurements, not zeros: the xnio - ;; MXBean may transiently report -1 on the busy thread count. + ;; negative values are missing measurements, not zeros: the xnio MXBean + ;; may transiently report -1. (when (>= queue-size 0) (mtx/run! metrics :id :http-worker-queue-size :val queue-size)) - (when (>= busy-count 0) - (mtx/run! metrics :id :http-worker-busy-threads :val busy-count)) - (when (>= pool-size 0) (mtx/run! metrics :id :http-worker-pool-size :val pool-size)) @@ -121,26 +119,14 @@ (defn create-metrics-sampler "Creates a daemon scheduler that periodically samples the state of - the http server and publishes it as metrics. A single thread is used, - and an unexpected error on a single sample does NOT cancel the - subsequent runs." + the http server and publishes it as metrics, in the shape shared by + `app.metrics/create-sampler`: a single thread, and an unexpected error + on one sample does not cancel the following runs." [^Undertow server metrics] - (let [state (atom {:last-requests 0 :last-errors 0}) - scheduler (px/scheduled-executor - :parallelism 1 - :factory (px/thread-factory :prefix "penpot/http-metrics/" - :daemon true)) - sample (fn sample [] - (try - (sample-http-metrics metrics state server) - (finally - ;; reschedule even if a single sample fails, so - ;; an unexpected error does not cancel the - ;; following runs. - (px/schedule scheduler metrics-sample-interval-ms sample))))] - - (px/schedule scheduler 0 sample) - scheduler)) + (let [state (atom {:last-requests 0 :last-errors 0})] + (mtx/create-sampler metrics-sample-interval-ms + (fn [] (sample-http-metrics metrics state server)) + {:name "http-metrics"}))) (defmethod ig/expand-key ::server [k v] diff --git a/backend/src/app/http/debug.clj b/backend/src/app/http/debug.clj index 5884e8e4bd..6995464290 100644 --- a/backend/src/app/http/debug.clj +++ b/backend/src/app/http/debug.clj @@ -25,6 +25,7 @@ [app.config :as cf] [app.db :as db] [app.features.file-migrations :as feat.fmig] + [app.health :as health] [app.http.session :as session] [app.redis :as rds] [app.rpc.commands.auth :as auth] @@ -857,17 +858,23 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn health-handler - "Mainly a task that performs a health check." + "Mainly a task that performs a health check. When the instance is marked + as offline (see `app.health`), it reports the instance as unavailable + without querying the database, so the load balancer drains it while the + requests in flight are still served." [{:keys [::db/pool]} _] - (try - (db/exec-one! pool ["select count(*) as count from server_prop;"]) - {::yres/status 200 - ::yres/body "OK"} - (catch Throwable cause - (l/warn :hint "unable to execute query on health handler" - :cause cause) - {::yres/status 503 - ::yres/body "KO"}))) + (if (health/online?) + (try + (db/exec-one! pool ["select count(*) as count from server_prop;"]) + {::yres/status 200 + ::yres/body "OK"} + (catch Throwable cause + (l/warn :hint "unable to execute query on health handler" + :cause cause) + {::yres/status 503 + ::yres/body "KO"})) + {::yres/status 503 + ::yres/body "OFFLINE"})) (defn changelog-handler [_ _] diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj index d9ce4bf7c2..d1cff7f2ab 100644 --- a/backend/src/app/main.clj +++ b/backend/src/app/main.clj @@ -107,17 +107,17 @@ ::mdef/labels ["name"] ::mdef/type :histogram} - :rpc-climit-queue - {::mdef/name "penpot_rpc_climit_queue" - ::mdef/help "Current number of queued submissions." + :rpc-climit-waiting + {::mdef/name "penpot_rpc_climit_waiting" + ::mdef/help "Calls of this limiter name waiting for a permit, on this instance." ::mdef/labels ["name"] ::mdef/type :gauge} - :rpc-climit-permits - {::mdef/name "penpot_rpc_climit_permits" - ::mdef/help "Current number of available permits" - ::mdef/labels ["name"] - ::mdef/type :gauge} + :rpc-climit-rejected + {::mdef/name "penpot_rpc_climit_rejected_total" + ::mdef/help "Calls rejected by this limiter, by name and reason." + ::mdef/labels ["name" "reason"] + ::mdef/type :counter} :rpc-climit-timing {::mdef/name "penpot_rpc_climit_timing" @@ -197,11 +197,6 @@ ::mdef/help "Current number of queued tasks in the http server xnio worker." ::mdef/type :gauge} - :http-worker-busy-threads - {::mdef/name "penpot_http_worker_busy_threads" - ::mdef/help "Current number of busy threads in the http server xnio worker." - ::mdef/type :gauge} - :http-worker-pool-size {::mdef/name "penpot_http_worker_pool_size" ::mdef/help "Current number of threads in the http server xnio worker pool." diff --git a/backend/src/app/metrics.clj b/backend/src/app/metrics.clj index aff1e846f5..04bcd74cab 100644 --- a/backend/src/app/metrics.clj +++ b/backend/src/app/metrics.clj @@ -10,7 +10,8 @@ [app.common.logging :as l] [app.common.schema :as sm] [app.metrics.definition :as-alias mdef] - [integrant.core :as ig]) + [integrant.core :as ig] + [promesa.exec :as px]) (:import io.prometheus.client.CollectorRegistry io.prometheus.client.Counter @@ -183,6 +184,33 @@ (report-safe-failure! (str "unable to record metric " (pr-str id)) cause) nil)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; SAMPLER +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn create-sampler + "Create a daemon scheduler that runs `sample` every `interval-ms`, + starting right away. A single thread is used, named after `name` + (default `metrics`), and an unexpected error on a single sample does NOT + cancel the following runs: the next run is scheduled in a `finally`. + The caller owns the returned scheduler and has to shut it down + (`px/shutdown-now`) when its component halts." + ([interval-ms sample] + (create-sampler interval-ms sample {})) + ([interval-ms sample {:keys [name] :or {name "metrics"}}] + (let [prefix (str "penpot/" name "/") + scheduler (px/scheduled-executor + :parallelism 1 + :factory (px/thread-factory :prefix prefix :daemon true)) + task (fn task [] + (try + (sample) + (finally + (px/schedule scheduler interval-ms task))))] + + (px/schedule scheduler 0 task) + scheduler))) + (defn- create-registry [] (let [registry (CollectorRegistry.)] diff --git a/backend/src/app/migrations.clj b/backend/src/app/migrations.clj index 8f42f8b9e4..c83405e2bf 100644 --- a/backend/src/app/migrations.clj +++ b/backend/src/app/migrations.clj @@ -517,7 +517,10 @@ :fn (mg/resource "app/migrations/sql/0156-add-storage-object-json-dedup-index.sql")} {:name "0153-del-orphan-profile-rels-after-team-leave" - :fn (mg/resource "app/migrations/sql/0153-del-orphan-profile-rels-after-team-leave.sql")}]) + :fn (mg/resource "app/migrations/sql/0153-del-orphan-profile-rels-after-team-leave.sql")} + + {:name "0154-del-legacy-file-object-thumbnail-table" + :fn (mg/resource "app/migrations/sql/0154-del-legacy-file-object-thumbnail-table.sql")}]) (defn apply-migrations! [pool name migrations] diff --git a/backend/src/app/migrations/sql/0154-del-legacy-file-object-thumbnail-table.sql b/backend/src/app/migrations/sql/0154-del-legacy-file-object-thumbnail-table.sql new file mode 100644 index 0000000000..b0ecd778fa --- /dev/null +++ b/backend/src/app/migrations/sql/0154-del-legacy-file-object-thumbnail-table.sql @@ -0,0 +1,7 @@ +--- The `file_object_thumbnail` table was replaced by +--- `file_tagged_object_thumbnail` and nothing references it anymore: no query +--- in the codebase touches it and it is empty in production. +--- +--- NOTE: the storage bucket named "file-object-thumbnail" (the one used by +--- `file_tagged_object_thumbnail`) has nothing to do with this table and stays. +DROP TABLE IF EXISTS file_object_thumbnail; diff --git a/backend/src/app/rpc/climit.clj b/backend/src/app/rpc/climit.clj index daff05550b..82fe9ff234 100644 --- a/backend/src/app/rpc/climit.clj +++ b/backend/src/app/rpc/climit.clj @@ -21,10 +21,12 @@ [clojure.set :as set] [datoteka.fs :as fs] [integrant.core :as ig] + [promesa.exec :as px] [promesa.exec.bulkhead :as pbh]) (:import clojure.lang.ExceptionInfo - java.util.concurrent.atomic.AtomicLong)) + java.util.concurrent.atomic.AtomicLong + java.util.concurrent.ConcurrentHashMap)) (set! *warn-on-reflection* true) @@ -54,6 +56,71 @@ (def ^:private check-config (sm/check-fn schema:config)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; WAITING COUNTER +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def ^:private waiting-sample-interval-ms 15000) + +(defn- create-waiting-counters + "Per limiter name, how many calls on this instance are waiting for a + permit. Every limiter of a name adds to the same entry, so the value does + not depend on which of them ran last the way a sampled gauge does: a + request that enters and never leaves stays visible for ever. The map + belongs to the component, so its counts die with it instead of surviving + into the next system built in the same JVM." + [] + (ConcurrentHashMap.)) + +(defn- waiting-counter + ^AtomicLong + [^ConcurrentHashMap counters name] + (.computeIfAbsent counters name + (reify java.util.function.Function + (apply [_ _] (AtomicLong. 0))))) + +(defn- publish-waiting + [metrics name value] + (mtx/run! metrics + :id :rpc-climit-waiting + :val value + :labels (into-array String [name]))) + +(defn- waiting-inc + [metrics counters name] + (publish-waiting metrics name (.incrementAndGet (waiting-counter counters name)))) + +(defn- waiting-dec + [metrics counters name] + (publish-waiting metrics name (.decrementAndGet (waiting-counter counters name)))) + +(defn- republish-waiting + "Publish the waiting count of every name again. A count that stops changing + (a limiter whose requests never come back and whose traffic died) has to keep + being written, or the series goes stale and the pile-up disappears." + [metrics counters] + (doseq [[name counter] counters] + (publish-waiting metrics name (.get ^AtomicLong counter)))) + +(defn- create-waiting-sampler + "A daemon sampler that republishes the waiting counts of this component." + [metrics counters] + (mtx/create-sampler waiting-sample-interval-ms + (fn [] (republish-waiting metrics counters)) + {:name "climit-metrics"})) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; COMPONENT +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defrecord ConcurrencyLimiter [params cache metrics counters sampler] + IConcurrencyLimiter + (get-config [_ id] + (get params id)) + + (invoke [_ config handler] + (impl-invoke metrics counters cache config handler))) + (def ^:private schema:climit-params [:map ::mtx/metrics @@ -70,19 +137,24 @@ (when enabled (when-let [params (some->> config slurp edn/read-string check-config)] (l/inf :hint "initializing concurrency limit" :config (str config)) - (let [params (reduce-kv (fn [result k v] - (assoc result k (assoc v ::id k))) - params - params) - cache (create-cache cfg)] + (let [params (reduce-kv (fn [result k v] + (when-not (:timeout v) + (l/wrn :hint "limiter without timeout, a saturated one parks its threads forever" + :id k)) + (assoc result k (assoc v ::id k))) + params + params) + cache (create-cache cfg) + counters (create-waiting-counters)] - (reify - IConcurrencyLimiter - (get-config [_ id] - (get params id)) + (->ConcurrencyLimiter params cache metrics counters + (create-waiting-sampler metrics counters)))))) - (invoke [_ config handler] - (impl-invoke metrics cache config handler))))))) +(defmethod ig/halt-key! ::rpc/climit + [_ instance] + (when-let [sampler (:sampler instance)] + (l/inf :hint "stopping concurrency limit metrics") + (px/shutdown-now sampler))) (defn- id->str ([id] @@ -110,28 +182,15 @@ :keepalive "5m"))) (defn- measure - [metrics mlabels stats elapsed] - (let [mpermits (:max-permits stats) - permits (:permits stats) - queue (:queue stats) - queue (- queue mpermits) - queue (if (neg? queue) 0 queue)] - - (mtx/run! metrics - :id :rpc-climit-queue - :val queue - :labels mlabels) - - (mtx/run! metrics - :id :rpc-climit-permits - :val permits - :labels mlabels) - - (when elapsed - (mtx/run! metrics - :id :rpc-climit-timing - :val (inst-ms elapsed) - :labels mlabels)))) + "Publish the wait time of a call that got its permit, in milliseconds. The + queue is not published here: a gauge written by whichever limiter of the name + ran last cannot show it, and the `:rpc-climit-waiting` gauge accumulates the + entries and the exits instead." + [metrics mlabels elapsed] + (mtx/run! metrics + :id :rpc-climit-timing + :val (inst-ms elapsed) + :labels mlabels)) (defn- prepare-params-for-debug [params] @@ -140,7 +199,7 @@ (update-vals str))) (defn- log - [action req-id stats limit-id limit-label limit-params elapsed] + [{:keys [id label params permits queue-max]} action req-id stats elapsed code reason] (let [mpermits (:max-permits stats) queue (:queue stats) queue (- queue mpermits) @@ -150,58 +209,109 @@ (l/log level :hint action :req req-id - :id limit-id - :label limit-label + :id id + :label label :queue queue + :queue-max queue-max + :permits permits :elapsed (some-> elapsed ct/format-duration) - :params @limit-params))) + :code code + :reason reason + :params @params))) (def ^:private idseq (AtomicLong. 0)) +(def ^:private ^ThreadLocal held-limiters + ;; Limiters a thread is inside of, identified by the limiter instance, which + ;; already encodes the limit id and its key: the cache is per id+key pair. + ;; `pbh/invoke!` runs the handler on the calling thread, so a handler that + ;; enters climit again for a limit it holds finds it here. Without this a + ;; thread parks forever behind a permit it holds itself. + (ThreadLocal/withInitial + (reify java.util.function.Supplier + (get [_] (java.util.HashSet.))))) + (defn- impl-invoke - [metrics cache config handler] + [metrics counters cache config handler] (let [limit-id (::id config) limit-key (::key config) limit-label (::label config) + limit-name (id->str limit-id) limit-params (delay (prepare-params-for-debug (::params config))) - mlabels (into-array String [(id->str limit-id)]) - limit-id (id->str limit-id limit-key) - limiter (cache/get cache limit-id (partial create-limiter config)) - tpoint (ct/tpoint) - req-id (.incrementAndGet ^AtomicLong idseq)] - (try - (let [stats (pbh/get-stats limiter)] - (measure metrics mlabels stats nil) - (log "enqueued" req-id stats limit-id limit-label limit-params nil)) + mlabels (into-array String [limit-name]) + limit-id (id->str limit-id limit-key) + limit {:id limit-id + :label limit-label + :params limit-params + :permits (or (:permits config) (:concurrency config) 1) + :queue-max (or (:queue config) (:queue-size config))} + limiter (cache/get cache limit-id (partial create-limiter config)) + held ^java.util.Set (.get ^ThreadLocal held-limiters)] - (pbh/invoke! limiter (fn [] - (let [elapsed (tpoint) - stats (pbh/get-stats limiter)] - (measure metrics mlabels stats elapsed) - (log "acquired" req-id stats limit-id limit-label limit-params elapsed) - (handler)))) + (if (.contains held limiter) + ;; The calling thread already holds this limiter for this key: run the + ;; handler inline instead of queueing behind itself. + (do + (l/trc :hint "reentrant invocation" :id limit-id :label limit-label) + (handler)) - (catch ExceptionInfo cause - (let [{:keys [type code]} (ex-data cause)] - (if (= :bulkhead-error type) + (let [tpoint (ct/tpoint) + req-id (.incrementAndGet ^AtomicLong idseq) + waiting (volatile! true) + stop-waiting (fn [] + ;; Exactly one decrement per increment: the flag + ;; makes a second call a no-op and the `finally` + ;; guarantees that there is one. + (when @waiting + (vreset! waiting false) + (waiting-dec metrics counters limit-name)))] + + (.add held limiter) + + (try + ;; The increment lives inside the `try`, so a throwable from the + ;; publishing path unwinds through the `finally`: the thread drops the + ;; mark and the count comes back down instead of staying up for good. + (waiting-inc metrics counters limit-name) + + (let [stats (pbh/get-stats limiter)] + (log limit "enqueued" req-id stats nil nil nil)) + + (pbh/invoke! limiter (fn [] + (stop-waiting) + (let [elapsed (tpoint) + stats (pbh/get-stats limiter)] + (measure metrics mlabels elapsed) + (log limit "acquired" req-id stats elapsed nil nil) + (handler)))) + + (catch ExceptionInfo cause + (let [{:keys [type code] :as data} (ex-data cause)] + (if (= :bulkhead-error type) + (let [elapsed (tpoint) + stats (pbh/get-stats limiter) + reason (if (some? (:timeout data)) "timeout" "queue-full")] + (mtx/run! metrics + :id :rpc-climit-rejected + :inc 1 + :labels (into-array String [limit-name reason])) + (log limit "rejected" req-id stats elapsed code reason) + (ex/raise :type :concurrency-limit + :code code + :hint "concurrency limit reached" + :cause cause)) + (throw cause)))) + + (finally + (.remove held limiter) + (stop-waiting) (let [elapsed (tpoint) stats (pbh/get-stats limiter)] - (log "rejected" req-id stats limit-id limit-label limit-params elapsed) - (ex/raise :type :concurrency-limit - :code code - :hint "concurrency limit reached" - :cause cause)) - (throw cause)))) - (finally - (let [elapsed (tpoint) - stats (pbh/get-stats limiter)] - - (measure metrics mlabels stats nil) - (log "finished" req-id stats limit-id limit-label limit-params elapsed)))))) + (log limit "finished" req-id stats elapsed nil nil)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; MIDDLEWARE @@ -263,7 +373,13 @@ (l/wrn :hint "no config found for specified queue" :id (id->str limit-id)) handler))) handler - (concat global-limits (get-limits mdata))) + ;; The root limiters go last so they end up outermost: every path + ;; meets them before the command's own limits. The nested + ;; `climit/invoke!` chains carry only the command's own limits and + ;; run inside those of the enclosing call, so this puts both paths + ;; in the same order. With the opposite order two calls of the same + ;; profile hold the same limiters inverted and park for good. + (concat (get-limits mdata) global-limits)) handler)) diff --git a/backend/src/app/rpc/commands/audit.clj b/backend/src/app/rpc/commands/audit.clj index 51e95595c0..893160a23e 100644 --- a/backend/src/app/rpc/commands/audit.clj +++ b/backend/src/app/rpc/commands/audit.clj @@ -162,8 +162,7 @@ [:events [:vector schema:frontend-event]]]) (sv/defmethod ::push-audit-events - {::climit/id :submit-audit-events/by-profile - ::climit/key-fn ::rpc/profile-id + {::climit/id [[:submit-audit-events/by-profile ::rpc/profile-id]] ::sm/params schema:push-audit-events ::audit/skip true ::doc/skip true diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj index e10dcd4b9e..fd313f6170 100644 --- a/backend/src/app/rpc/commands/files.clj +++ b/backend/src/app/rpc/commands/files.clj @@ -1333,6 +1333,40 @@ "UPDATE file_tagged_object_thumbnail SET deleted_at = null WHERE file_id = ANY(?::uuid[])") +(def ^:private sql:restore-storage-objects + "WITH ids AS (SELECT unnest(?::uuid[]) AS file_id) + + UPDATE storage_object + SET deleted_at = null + WHERE deleted_at IS NOT NULL + AND (id IN (SELECT media_id + FROM file_media_object AS fmo + JOIN ids ON (ids.file_id = fmo.file_id) + WHERE fmo.deleted_at IS NULL + AND fmo.media_id IS NOT NULL + UNION + SELECT thumbnail_id + FROM file_media_object AS fmo + JOIN ids ON (ids.file_id = fmo.file_id) + WHERE fmo.deleted_at IS NULL + AND fmo.thumbnail_id IS NOT NULL + UNION + SELECT ft.media_id + FROM file_thumbnail AS ft + JOIN ids ON (ids.file_id = ft.file_id) + WHERE ft.deleted_at IS NULL + AND ft.media_id IS NOT NULL + UNION + SELECT fot.media_id + FROM file_tagged_object_thumbnail AS fot + JOIN ids ON (ids.file_id = fot.file_id) + WHERE fot.deleted_at IS NULL + AND fot.media_id IS NOT NULL) + OR id::text IN (SELECT fd.metadata->>'storage-ref-id' + FROM file_data AS fd + JOIN ids ON (ids.file_id = fd.file_id) + WHERE fd.deleted_at IS NULL))") + (defn- restore-files [conn file-ids] (let [file-ids (db/create-array conn "uuid" file-ids)] @@ -1341,7 +1375,13 @@ (db/exec-one! conn [sql:restore-file-changes file-ids]) (db/exec-one! conn [sql:restore-file-data file-ids]) (db/exec-one! conn [sql:restore-file-thumbnails file-ids]) - (db/exec-one! conn [sql:restore-file-tagged-object-thumbnails file-ids]))) + (db/exec-one! conn [sql:restore-file-tagged-object-thumbnails file-ids]) + + ;; NOTE: the storage objects referenced by the rows we just brought back + ;; must stop being marked for deletion. The storage GC cannot delete an + ;; object that a live row references (those foreign keys are `NO ACTION`), + ;; so a marked object that comes back to life is skipped forever otherwise. + (db/exec-one! conn [sql:restore-storage-objects file-ids]))) (def ^:private sql:restore-projects "UPDATE project SET deleted_at = null WHERE id = ANY(?::uuid[])") diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index 7123917900..b617934c46 100644 --- a/backend/src/app/srepl/main.clj +++ b/backend/src/app/srepl/main.clj @@ -25,6 +25,7 @@ [app.db.sql :as-alias sql] [app.features.fdata :as fdata] [app.features.file-snapshots :as fsnap] + [app.health :as health] [app.http.session :as session] [app.loggers.audit :as audit] [app.msgbus :as mbus] @@ -95,6 +96,30 @@ profile (profile/get-profile-by-email conn email)] (#'auth/send-email-verification! cfg profile))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; INSTANCE AVAILABILITY +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn set-offline + "Take this instance out of the load balancer. + + The `/readyz` endpoint starts answering 503, so the load balancer + removes the instance from rotation. Requests already in flight are + still served; wait for the load balancer to notice and for the traffic + to drop before restarting the process. + + A restarted process comes back online on its own." + [] + (health/set-offline)) + +(defn set-online + "Put this instance back into the load balancer rotation. + + Only needed to undo a `set-offline` without a restart; a restarted + process starts online." + [] + (health/set-online)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PROFILES MANAGEMENT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -767,6 +792,15 @@ :id team-id}))) :deleted)) +(def ^:private sql:restore-font-file-objects + "UPDATE storage_object + SET deleted_at = null + WHERE deleted_at IS NOT NULL + AND id IN (SELECT unnest(array[woff1_file_id, woff2_file_id, otf_file_id, ttf_file_id]) + FROM team_font_variant + WHERE team_id = ?::uuid + AND deleted_at IS NULL)") + (defn- restore-team* [{:keys [::db/conn] :as cfg} team-id] (db/update! conn :team @@ -777,6 +811,11 @@ {:deleted-at nil} {:team-id team-id}) + ;; Same as in `restore-files`: the font objects of the variants we just + ;; brought back must stop being marked for deletion, or the storage GC will + ;; skip them forever (those foreign keys are `NO ACTION`). + (db/exec-one! conn [sql:restore-font-file-objects team-id]) + (doseq [{:keys [id]} (db/query conn :project {:team-id team-id} {::sql/columns [:id]})] @@ -875,45 +914,69 @@ ;; CASCADE FIXING ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defn- submit-deleted-cascade + "Replay the deletion cascade of every soft-deleted row of `table`, by + submitting one `:delete-object` task per row. + + Reads the rows with a server-side cursor (`db/plan`) instead of materialising + the whole table, and enqueues the task instead of running it inline, so it + can be used against production in bounded batches. The task is idempotent (it + only marks the children with the row's own date), `label` is the row id and + `dedupe` drops not-yet-due duplicates. + + Options: `:limit` (max rows read), `:ids` (restrict the run to these row ids) + and `:dry-run?` (count without enqueueing). `table` and `object` are internal + constants, never operator input. + + Returns `{:found n :submitted m}`. + + Note: the submissions are given the outer `system` (with the pool) on + purpose; handing them the read-only transaction cfg would write on it." + [system {:keys [table object limit ids dry-run?]}] + (let [clauses (cond-> ["deleted_at is not null"] + (seq ids) (conj "id = any(?)")) + sql (str "select id, deleted_at from " table + " where " (str/join " and " clauses) + (when limit (str " limit " (long limit))))] + + (db/tx-run! (assoc system ::db/read-only true) + (fn [{:keys [::db/conn]}] + (let [query (cond-> [sql] + (seq ids) (conj (db/create-array conn "uuid" ids))) + found (reduce (fn [total {:keys [id deleted-at]}] + (when-not dry-run? + (wrk/submit! (-> system + (assoc ::wrk/task :delete-object) + (assoc ::wrk/params {:object object + :deleted-at deleted-at + :id id}) + (assoc ::wrk/label (str id)) + (assoc ::wrk/dedupe true)))) + (inc total)) + 0 + (db/plan conn query))] + {:found found + :submitted (if dry-run? 0 found)}))))) + (defn process-deleted-profiles-cascade - [] - (->> (db/exec! sys/system ["select id, deleted_at from profile where deleted_at is not null"]) - (run! (fn [{:keys [id deleted-at]}] - (wrk/invoke! (-> sys/system - (assoc ::wrk/task :delete-object) - (assoc ::wrk/params {:object :profile - :deleted-at deleted-at - :id id}))))))) + "Replay the deletion cascade of every soft-deleted profile." + [& {:as opts}] + (submit-deleted-cascade sys/system (merge {:table "profile" :object :profile} opts))) (defn process-deleted-teams-cascade - [] - (->> (db/exec! sys/system ["select id, deleted_at from team where deleted_at is not null"]) - (run! (fn [{:keys [id deleted-at]}] - (wrk/invoke! (-> sys/system - (assoc ::wrk/task :delete-object) - (assoc ::wrk/params {:object :team - :deleted-at deleted-at - :id id}))))))) + "Replay the deletion cascade of every soft-deleted team." + [& {:as opts}] + (submit-deleted-cascade sys/system (merge {:table "team" :object :team} opts))) (defn process-deleted-projects-cascade - [] - (->> (db/exec! sys/system ["select id, deleted_at from project where deleted_at is not null"]) - (run! (fn [{:keys [id deleted-at]}] - (wrk/invoke! (-> sys/system - (assoc ::wrk/task :delete-object) - (assoc ::wrk/params {:object :project - :deleted-at deleted-at - :id id}))))))) + "Replay the deletion cascade of every soft-deleted project." + [& {:as opts}] + (submit-deleted-cascade sys/system (merge {:table "project" :object :project} opts))) (defn process-deleted-files-cascade - [] - (->> (db/exec! sys/system ["select id, deleted_at from file where deleted_at is not null"]) - (run! (fn [{:keys [id deleted-at]}] - (wrk/invoke! (-> sys/system - (assoc ::wrk/task :delete-object) - (assoc ::wrk/params {:object :file - :deleted-at deleted-at - :id id}))))))) + "Replay the deletion cascade of every soft-deleted file." + [& {:as opts}] + (submit-deleted-cascade sys/system (merge {:table "file" :object :file} opts))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SSO diff --git a/backend/src/app/storage/gc_deleted.clj b/backend/src/app/storage/gc_deleted.clj index 7048bd4d2e..6c7e419676 100644 --- a/backend/src/app/storage/gc_deleted.clj +++ b/backend/src/app/storage/gc_deleted.clj @@ -28,7 +28,7 @@ 7) (def ^:private chunk-size - "Number of rows to process per transaction." + "Pending objects deleted in each transaction." 25) (def ^:private sql:lock-sobjects @@ -93,9 +93,9 @@ (defn- process-chunk "Attempt to delete a chunk of storage objects from a specific backend. - This function runs inside the caller's transaction (clean-deleted) — - it does NOT open its own transaction. The caller is responsible for - ensuring the rows are locked via FOR UPDATE SKIP LOCKED before calling. + This function runs inside the chunk's own transaction (see + `delete-in-bulk`) — it does NOT open its own transaction. The rows are + locked via FOR UPDATE SKIP LOCKED before deleting. Returns the number of successfully deleted objects, or 0 if no rows could be locked." @@ -141,40 +141,65 @@ (count ok-ids)) 0)) +(defn- delete-in-bulk + [cfg backend-id ids] + ;; Each chunk runs in its own transaction, on its own connection: a chunk + ;; that fails (for example, an object that a foreign key still references) is + ;; logged and skipped, and it cannot poison the cursor that feeds the rest. + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::sto/storage]}] + (process-chunk conn storage backend-id ids))) + (catch Throwable cause + (l/err :hint "unexpected error on bulk deletion, skipping chunk" + :ids ids + :cause cause) + 0))) + (defn- group-by-backend [items] (d/group-by (comp keyword :backend) :id #{} items)) -(def ^:private sql:get-deleted-chunk +(def ^:private sql:get-deleted-sobjects "SELECT id, backend FROM storage_object WHERE deleted_at IS NOT NULL AND deleted_at <= ? AND status = 'valid' - ORDER BY deleted_at ASC - LIMIT ? - FOR UPDATE - SKIP LOCKED") + ORDER BY deleted_at ASC") -(defn- get-deleted-chunk - [conn size] - (db/exec! conn [sql:get-deleted-chunk (ct/now) size])) +(defn- pending-row + "Takes the columns the GC needs from a `db/plan` row. + + A plan row is a view over the open result set, valid only while the reduction + is running, so it cannot be stored for later: this has to happen inside the + reducing function." + [row] + {:id (:id row) + :backend (:backend row)}) (defn- clean-deleted + "Walks the pending objects with `db/plan`, a server-side cursor that streams + the rows instead of materialising them, and deletes them chunk by chunk. + + The rows are read in their own read-only transaction and every chunk of + `chunk-size` objects is deleted in its own one (see `delete-in-bulk`), so a + chunk that fails is logged and skipped instead of aborting the whole run, and + the work of the previous chunks is already committed. A physical-deletion + failure inside a chunk defers its rows one day and gives up after + `max-attempts` attempts (see `process-chunk`)." [cfg] - (loop [total 0] - (let [deleted (db/tx-run! cfg - (fn [{:keys [::db/conn ::sto/storage]}] - (let [chunk (get-deleted-chunk conn chunk-size)] - (when (seq chunk) - (let [by-backend (group-by-backend chunk)] - (reduce-kv (fn [acc backend-id ids] - (+ acc (process-chunk conn storage backend-id ids))) - 0 - by-backend))))))] - (if deleted - (recur (+ total deleted)) - total)))) + (let [xform (comp (map pending-row) + (partition-all chunk-size) + (mapcat group-by-backend)) + rf (fn + ([total] total) + ([total [backend-id ids]] + (+ total (or (delete-in-bulk cfg backend-id ids) 0))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce xform rf 0 + (db/plan conn [sql:get-deleted-sobjects (ct/now)])))))) (defmethod ig/assert-key ::handler [_ params] diff --git a/backend/src/app/tasks/objects_gc.clj b/backend/src/app/tasks/objects_gc.clj index daf5619ae6..7ddc210291 100644 --- a/backend/src/app/tasks/objects_gc.clj +++ b/backend/src/app/tasks/objects_gc.clj @@ -16,6 +16,17 @@ [app.tasks.delete-object :as dobj] [integrant.core :as ig])) +;; Each proc below streams its pending keys with `db/plan`, a server-side +;; cursor, inside a read-only transaction of its own, and deletes them chunk +;; by chunk, each chunk in a transaction of its own, unrelated to the plan +;; one. A chunk that fails is rolled back on its own, reported with `l/err` +;; and skipped, so it takes down its own work and nothing else: the run keeps +;; going and the next run retries the skipped rows. +;; +;; A plan row is a view over the open result set, valid only while the +;; reduction is running, so the key is read inside the reducing function: +;; buffering the row itself yields nil columns. + (def ^:private sql:get-upload-sessions "SELECT us.id FROM upload_session AS us @@ -28,8 +39,21 @@ WHERE p.id = us.profile_id AND p.deleted_at IS NOT NULL AND p.deleted_at <= ?) - ORDER BY us.created_at ASC - LIMIT ? + ORDER BY us.created_at ASC") + +(def ^:private sql:lock-upload-sessions + "SELECT us.id + FROM upload_session AS us + WHERE us.id = ANY(?::uuid[]) + AND ((us.deleted_at IS NOT NULL + AND us.deleted_at <= ?) + OR (us.deleted_at IS NULL + AND us.created_at <= ?) + OR EXISTS (SELECT 1 + FROM profile AS p + WHERE p.id = us.profile_id + AND p.deleted_at IS NOT NULL + AND p.deleted_at <= ?)) FOR UPDATE OF us SKIP LOCKED") @@ -38,332 +62,595 @@ WHERE session_id = ? RETURNING object_id") -(defn- delete-upload-sessions! - "Purges consumed upload sessions (marked by assemble-chunks), stalled - sessions (never assembled within max-age) and sessions owned by profiles - pending purge. Referenced storage objects are touched so the storage GC - reclaims them with its usual delay; chunk mappings are removed before the - session row (NO ACTION foreign keys)." - [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}] - (let [stalled-threshold (ct/minus timestamp {:hours 1})] - (->> (db/plan conn [sql:get-upload-sessions timestamp stalled-threshold timestamp chunk-size] - {:fetch-size 5}) - (reduce (fn [total {:keys [id]}] - (l/trc :obj "upload-session" :id (str id)) +(defn- delete-upload-sessions-chunk + "Purges one chunk of consumed upload sessions (marked by assemble-chunks), + stalled sessions (never assembled within max-age) and sessions owned by + profiles pending purge. Referenced storage objects are touched so the + storage GC reclaims them with its usual delay; chunk mappings are removed + before the session row (NO ACTION foreign keys)." + [cfg ids] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp ::sto/storage]}] + (let [stalled-threshold (ct/minus timestamp {:hours 1}) + ids (db/create-array conn "uuid" ids)] + (->> (db/exec! conn [sql:lock-upload-sessions ids timestamp stalled-threshold timestamp]) + (reduce (fn [total {:keys [id]}] + (l/trc :obj "upload-session" :id (str id)) - ;; Remove the chunk mappings, marking as touched all - ;; related storage objects in a single round-trip. - (doseq [{:keys [object-id]} (db/exec! conn [sql:delete-session-chunks id])] - (some->> object-id (sto/touch-object! storage))) + ;; Remove the chunk mappings, marking as touched all + ;; related storage objects in a single round-trip. + (doseq [{:keys [object-id]} (db/exec! conn [sql:delete-session-chunks id])] + (some->> object-id (sto/touch-object! storage))) - (let [affected (-> (db/delete! conn :upload-session {:id id}) - (db/get-update-count))] - (+ total affected))) - 0)))) + (let [affected (-> (db/delete! conn :upload-session {:id id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "upload-session" + :hint "error on chunk deletion, skipping it" + :chunk ids + :cause cause) + 0))) + +(defn- delete-upload-sessions + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [stalled-threshold (ct/minus timestamp {:hours 1}) + rf (fn ([total] total) + ([total chunk] (+ total (delete-upload-sessions-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map :id) (partition-all chunk-size)) rf 0 + (db/plan conn [sql:get-upload-sessions timestamp stalled-threshold timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-profiles - "SELECT id, photo_id FROM profile + "SELECT id FROM profile WHERE deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-profiles + "SELECT id, photo_id, deleted_at FROM profile + WHERE id = ANY(?::uuid[]) + AND deleted_at IS NOT NULL + AND deleted_at <= ? FOR UPDATE SKIP LOCKED") -(defn- delete-profiles! - [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}] - (->> (db/plan conn [sql:get-profiles timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [id photo-id]}] - (l/trc :obj "profile" :id (str id)) +(defn- delete-profiles-chunk + [cfg ids] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp ::sto/storage] :as cfg}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [ids (db/create-array conn "uuid" ids)] + (->> (db/exec! conn [sql:lock-profiles ids timestamp]) + (reduce (fn [total {:keys [id photo-id deleted-at]}] + (l/trc :obj "profile" :id (str id)) - ;; Mark as deleted the storage object - (some->> photo-id (sto/touch-object! storage)) + ;; Mark as deleted the storage object + (some->> photo-id (sto/touch-object! storage)) - ;; Cascade soft-delete to owned teams, projects, files, etc. - (dobj/delete-object cfg {:object :profile - :id id - :deleted-at timestamp}) + ;; Cascade soft-delete to owned teams, projects, files, etc. + ;; with the deletion date of the profile, not the + ;; timestamp of the run. + (dobj/delete-object cfg {:object :profile + :id id + :deleted-at deleted-at}) - (let [affected (-> (db/delete! conn :profile {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :profile {:id id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "profile" + :hint "error on chunk deletion, skipping it" + :chunk ids + :cause cause) + 0))) + +(defn- delete-profiles + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-profiles-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map :id) (partition-all chunk-size)) rf 0 + (db/plan conn [sql:get-profiles timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-teams - "SELECT deleted_at, id, photo_id FROM team + "SELECT id FROM team WHERE deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-teams + "SELECT deleted_at, id, photo_id FROM team + WHERE id = ANY(?::uuid[]) + AND deleted_at IS NOT NULL + AND deleted_at <= ? FOR UPDATE SKIP LOCKED") -(defn- delete-teams! - [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}] - (->> (db/plan conn [sql:get-teams timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [id photo-id deleted-at]}] - (l/trc :obj "team" - :id (str id) - :deleted-at (ct/format-inst deleted-at)) +(defn- delete-teams-chunk + [cfg ids] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp ::sto/storage]}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [ids (db/create-array conn "uuid" ids)] + (->> (db/exec! conn [sql:lock-teams ids timestamp]) + (reduce (fn [total {:keys [id photo-id deleted-at]}] + (l/trc :obj "team" + :id (str id) + :deleted-at (ct/format-inst deleted-at)) - ;; Mark as deleted the storage object - (some->> photo-id (sto/touch-object! storage)) + ;; Mark as deleted the storage object + (some->> photo-id (sto/touch-object! storage)) - ;; And finally, permanently delete the team. - (let [affected (-> (db/delete! conn :team {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))) + ;; And finally, permanently delete the team. + (let [affected (-> (db/delete! conn :team {:id id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "team" + :hint "error on chunk deletion, skipping it" + :chunk ids + :cause cause) + 0))) + +(defn- delete-teams + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-teams-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map :id) (partition-all chunk-size)) rf 0 + (db/plan conn [sql:get-teams timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-fonts + "SELECT id FROM team_font_variant + WHERE deleted_at IS NOT NULL + AND deleted_at <= ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-fonts "SELECT id, team_id, deleted_at, woff1_file_id, woff2_file_id, otf_file_id, ttf_file_id FROM team_font_variant - WHERE deleted_at IS NOT NULL + WHERE id = ANY(?::uuid[]) + AND deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? FOR UPDATE SKIP LOCKED") -(defn- delete-fonts! - [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}] - (->> (db/plan conn [sql:get-fonts timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [id team-id deleted-at] :as font}] - (l/trc :obj "font-variant" - :id (str id) - :team-id (str team-id) - :deleted-at (ct/format-inst deleted-at)) +(defn- delete-fonts-chunk + [cfg ids] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp ::sto/storage]}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [ids (db/create-array conn "uuid" ids)] + (->> (db/exec! conn [sql:lock-fonts ids timestamp]) + (reduce (fn [total {:keys [id team-id deleted-at] :as font}] + (l/trc :obj "font-variant" + :id (str id) + :team-id (str team-id) + :deleted-at (ct/format-inst deleted-at)) - ;; Mark as deleted the all related storage objects - (some->> (:woff1-file-id font) (sto/touch-object! storage)) - (some->> (:woff2-file-id font) (sto/touch-object! storage)) - (some->> (:otf-file-id font) (sto/touch-object! storage)) - (some->> (:ttf-file-id font) (sto/touch-object! storage)) + ;; Mark as deleted the all related storage objects + (some->> (:woff1-file-id font) (sto/touch-object! storage)) + (some->> (:woff2-file-id font) (sto/touch-object! storage)) + (some->> (:otf-file-id font) (sto/touch-object! storage)) + (some->> (:ttf-file-id font) (sto/touch-object! storage)) - (let [affected (-> (db/delete! conn :team-font-variant {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :team-font-variant {:id id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "font-variant" + :hint "error on chunk deletion, skipping it" + :chunk ids + :cause cause) + 0))) + +(defn- delete-fonts + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-fonts-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map :id) (partition-all chunk-size)) rf 0 + (db/plan conn [sql:get-fonts timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-projects - "SELECT id, deleted_at, team_id - FROM project + "SELECT id FROM project WHERE deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-projects + "SELECT id, deleted_at, team_id FROM project + WHERE id = ANY(?::uuid[]) + AND deleted_at IS NOT NULL + AND deleted_at <= ? FOR UPDATE SKIP LOCKED") -(defn- delete-projects! - [{:keys [::db/conn ::timestamp ::chunk-size] :as cfg}] - (->> (db/plan conn [sql:get-projects timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [id team-id deleted-at]}] - (l/trc :obj "project" - :id (str id) - :team-id (str team-id) - :deleted-at (ct/format-inst deleted-at)) +(defn- delete-projects-chunk + [cfg ids] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp]}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [ids (db/create-array conn "uuid" ids)] + (->> (db/exec! conn [sql:lock-projects ids timestamp]) + (reduce (fn [total {:keys [id team-id deleted-at]}] + (l/trc :obj "project" + :id (str id) + :team-id (str team-id) + :deleted-at (ct/format-inst deleted-at)) - (let [affected (-> (db/delete! conn :project {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :project {:id id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "project" + :hint "error on chunk deletion, skipping it" + :chunk ids + :cause cause) + 0))) + +(defn- delete-projects + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-projects-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map :id) (partition-all chunk-size)) rf 0 + (db/plan conn [sql:get-projects timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-files - "SELECT f.id, - f.deleted_at, - f.project_id - FROM file AS f - WHERE f.deleted_at IS NOT NULL - AND f.deleted_at <= ? - ORDER BY f.deleted_at ASC - LIMIT ? + "SELECT id FROM file + WHERE deleted_at IS NOT NULL + AND deleted_at <= ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-files + "SELECT id, deleted_at, project_id FROM file + WHERE id = ANY(?::uuid[]) + AND deleted_at IS NOT NULL + AND deleted_at <= ? FOR UPDATE SKIP LOCKED") -(defn- delete-files! - [{:keys [::db/conn ::timestamp ::chunk-size] :as cfg}] - (->> (db/plan conn [sql:get-files timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [id deleted-at project-id] :as file}] - (l/trc :obj "file" - :id (str id) - :project-id (str project-id) - :deleted-at (ct/format-inst deleted-at)) +(defn- delete-files-chunk + [cfg ids] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp]}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [ids (db/create-array conn "uuid" ids)] + (->> (db/exec! conn [sql:lock-files ids timestamp]) + (reduce (fn [total {:keys [id deleted-at project-id]}] + (l/trc :obj "file" + :id (str id) + :project-id (str project-id) + :deleted-at (ct/format-inst deleted-at)) - (let [affected (-> (db/delete! conn :file {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :file {:id id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "file" + :hint "error on chunk deletion, skipping it" + :chunk ids + :cause cause) + 0))) + +(defn- delete-files + "Deletes the pending files chunk by chunk. + + A file that cannot be deleted (for example, because a child row was left + unmarked and its `NO ACTION` foreign key still points at it) aborts the + transaction of the whole chunk: the chunk is reported and skipped, and the + next run retries its files." + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-files-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map :id) (partition-all chunk-size)) rf 0 + (db/plan conn [sql:get-files timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-file-thumbnails + "SELECT file_id, revn FROM file_thumbnail + WHERE deleted_at IS NOT NULL + AND deleted_at <= ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-file-thumbnails "SELECT file_id, revn, media_id, deleted_at FROM file_thumbnail - WHERE deleted_at IS NOT NULL + WHERE (file_id, revn) IN (SELECT file_id, revn FROM unnest(?::uuid[], ?::bigint[]) AS u(file_id, revn)) + AND deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? FOR UPDATE SKIP LOCKED") -(defn delete-file-thumbnails! - [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}] - (->> (db/plan conn [sql:get-file-thumbnails timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [file-id revn media-id deleted-at]}] - (l/trc :obj "file-thumbnail" - :file-id (str file-id) - :revn revn - :deleted-at (ct/format-inst deleted-at)) +(defn- delete-file-thumbnails-chunk + [cfg rows] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp ::sto/storage]}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [file-ids (db/create-array conn "uuid" (map :file-id rows)) + revns (db/create-array conn "int8" (map :revn rows))] + (->> (db/exec! conn [sql:lock-file-thumbnails file-ids revns timestamp]) + (reduce (fn [total {:keys [file-id revn media-id deleted-at]}] + (l/trc :obj "file-thumbnail" + :file-id (str file-id) + :revn revn + :deleted-at (ct/format-inst deleted-at)) - ;; Mark as deleted the storage object - (some->> media-id (sto/touch-object! storage)) + ;; Mark as deleted the storage object + (some->> media-id (sto/touch-object! storage)) - (let [affected (-> (db/delete! conn :file-thumbnail {:file-id file-id :revn revn}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :file-thumbnail {:file-id file-id :revn revn}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "file-thumbnail" + :hint "error on chunk deletion, skipping it" + :chunk rows + :cause cause) + 0))) + +(defn- delete-file-thumbnails + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-file-thumbnails-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map (fn [row] {:file-id (:file-id row) :revn (:revn row)})) + (partition-all chunk-size)) + rf 0 + (db/plan conn [sql:get-file-thumbnails timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-file-object-thumbnails + "SELECT file_id, object_id FROM file_tagged_object_thumbnail + WHERE deleted_at IS NOT NULL + AND deleted_at <= ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-file-object-thumbnails "SELECT file_id, object_id, media_id, deleted_at FROM file_tagged_object_thumbnail - WHERE deleted_at IS NOT NULL + WHERE (file_id, object_id) IN (SELECT file_id, object_id FROM unnest(?::uuid[], ?::text[]) AS u(file_id, object_id)) + AND deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? FOR UPDATE SKIP LOCKED") -(defn delete-file-object-thumbnails! - [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}] - (->> (db/plan conn [sql:get-file-object-thumbnails timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [file-id object-id media-id deleted-at]}] - (l/trc :obj "file-object-thumbnail" - :file-id (str file-id) - :object-id object-id - :deleted-at (ct/format-inst deleted-at)) +(defn- delete-file-object-thumbnails-chunk + [cfg rows] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp ::sto/storage]}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [file-ids (db/create-array conn "uuid" (map :file-id rows)) + object-ids (db/create-array conn "text" (map :object-id rows))] + (->> (db/exec! conn [sql:lock-file-object-thumbnails file-ids object-ids timestamp]) + (reduce (fn [total {:keys [file-id object-id media-id deleted-at]}] + (l/trc :obj "file-object-thumbnail" + :file-id (str file-id) + :object-id object-id + :deleted-at (ct/format-inst deleted-at)) - ;; Mark as deleted the storage object - (some->> media-id (sto/touch-object! storage)) + ;; Mark as deleted the storage object + (some->> media-id (sto/touch-object! storage)) - (let [affected (-> (db/delete! conn :file-tagged-object-thumbnail - {:file-id file-id :object-id object-id}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :file-tagged-object-thumbnail + {:file-id file-id :object-id object-id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "file-object-thumbnail" + :hint "error on chunk deletion, skipping it" + :chunk rows + :cause cause) + 0))) + +(defn- delete-file-object-thumbnails + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-file-object-thumbnails-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map (fn [row] {:file-id (:file-id row) :object-id (:object-id row)})) + (partition-all chunk-size)) + rf 0 + (db/plan conn [sql:get-file-object-thumbnails timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-file-media-objects + "SELECT id FROM file_media_object + WHERE deleted_at IS NOT NULL + AND deleted_at <= ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-file-media-objects "SELECT id, file_id, media_id, thumbnail_id, deleted_at FROM file_media_object - WHERE deleted_at IS NOT NULL + WHERE id = ANY(?::uuid[]) + AND deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? FOR UPDATE SKIP LOCKED") -(defn- delete-file-media-objects! - [{:keys [::db/conn ::timestamp ::chunk-size ::sto/storage] :as cfg}] - (->> (db/plan conn [sql:get-file-media-objects timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [id file-id deleted-at] :as fmo}] - (l/trc :obj "file-media-object" - :id (str id) - :file-id (str file-id) - :deleted-at (ct/format-inst deleted-at)) +(defn- delete-file-media-objects-chunk + [cfg ids] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp ::sto/storage]}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [ids (db/create-array conn "uuid" ids)] + (->> (db/exec! conn [sql:lock-file-media-objects ids timestamp]) + (reduce (fn [total {:keys [id file-id deleted-at] :as fmo}] + (l/trc :obj "file-media-object" + :id (str id) + :file-id (str file-id) + :deleted-at (ct/format-inst deleted-at)) - ;; Mark as deleted the all related storage objects - (some->> (:media-id fmo) (sto/touch-object! storage)) - (some->> (:thumbnail-id fmo) (sto/touch-object! storage)) + ;; Mark as deleted the all related storage objects + (some->> (:media-id fmo) (sto/touch-object! storage)) + (some->> (:thumbnail-id fmo) (sto/touch-object! storage)) - (let [affected (-> (db/delete! conn :file-media-object {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :file-media-object {:id id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "file-media-object" + :hint "error on chunk deletion, skipping it" + :chunk ids + :cause cause) + 0))) + +(defn- delete-file-media-objects + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-file-media-objects-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map :id) (partition-all chunk-size)) rf 0 + (db/plan conn [sql:get-file-media-objects timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-file-data + "SELECT file_id, id FROM file_data + WHERE deleted_at IS NOT NULL + AND deleted_at <= ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-file-data "SELECT file_id, id, type, deleted_at, metadata, backend FROM file_data - WHERE deleted_at IS NOT NULL + WHERE (file_id, id) IN (SELECT file_id, id FROM unnest(?::uuid[], ?::uuid[]) AS u(file_id, id)) + AND deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? FOR UPDATE SKIP LOCKED") -(defn- delete-file-data! - [{:keys [::db/conn ::timestamp ::chunk-size] :as cfg}] - (->> (db/plan conn [sql:get-file-data timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [file-id id type deleted-at metadata backend]}] +(defn- delete-file-data-chunk + [cfg rows] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp] :as cfg}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [file-ids (db/create-array conn "uuid" (map :file-id rows)) + ids (db/create-array conn "uuid" (map :id rows))] + (->> (db/exec! conn [sql:lock-file-data file-ids ids timestamp]) + (reduce (fn [total {:keys [file-id id type deleted-at metadata backend]}] - (some->> metadata - (fdata/decode-metadata) - (fdata/process-metadata cfg)) + (some->> metadata + (fdata/decode-metadata) + (fdata/process-metadata cfg)) - (l/trc :obj "file-data" - :id (str id) - :file-id (str file-id) - :type type - :backend backend - :deleted-at (ct/format-inst deleted-at)) + (l/trc :obj "file-data" + :id (str id) + :file-id (str file-id) + :type type + :backend backend + :deleted-at (ct/format-inst deleted-at)) - (let [affected (-> (db/delete! conn :file-data - {:file-id file-id - :id id - :type type}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :file-data + {:file-id file-id + :id id + :type type}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "file-data" + :hint "error on chunk deletion, skipping it" + :chunk rows + :cause cause) + 0))) + +(defn- delete-file-data + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-file-data-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map (fn [row] {:file-id (:file-id row) :id (:id row)})) + (partition-all chunk-size)) + rf 0 + (db/plan conn [sql:get-file-data timestamp] + {:fetch-size 5})))))) (def ^:private sql:get-file-change - "SELECT id, file_id, deleted_at - FROM file_change + "SELECT id FROM file_change WHERE deleted_at IS NOT NULL AND deleted_at <= ? - ORDER BY deleted_at ASC - LIMIT ? + ORDER BY deleted_at ASC") + +(def ^:private sql:lock-file-change + "SELECT id, file_id, deleted_at FROM file_change + WHERE id = ANY(?::uuid[]) + AND deleted_at IS NOT NULL + AND deleted_at <= ? FOR UPDATE SKIP LOCKED") -(defn- delete-file-changes! - [{:keys [::db/conn ::timestamp ::chunk-size] :as cfg}] - (->> (db/plan conn [sql:get-file-change timestamp chunk-size] {:fetch-size 5}) - (reduce (fn [total {:keys [id file-id deleted-at] :as xlog}] - (l/trc :obj "file-change" - :id (str id) - :file-id (str file-id) - :deleted-at (ct/format-inst deleted-at)) +(defn- delete-file-changes-chunk + [cfg ids] + (try + (db/tx-run! cfg + (fn [{:keys [::db/conn ::timestamp]}] + (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) + (let [ids (db/create-array conn "uuid" ids)] + (->> (db/exec! conn [sql:lock-file-change ids timestamp]) + (reduce (fn [total {:keys [id file-id deleted-at]}] + (l/trc :obj "file-change" + :id (str id) + :file-id (str file-id) + :deleted-at (ct/format-inst deleted-at)) - (let [affected (-> (db/delete! conn :file-change {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))) + (let [affected (-> (db/delete! conn :file-change {:id id}) + (db/get-update-count))] + (+ total affected))) + 0))))) + (catch Throwable cause + (l/err :obj "file-change" + :hint "error on chunk deletion, skipping it" + :chunk ids + :cause cause) + 0))) -(def ^:private deletion-proc-vars - ;; NOTE: upload sessions go first: deleting a profile cascades to its - ;; sessions, which would hit the upload_session_chunk NO ACTION foreign key - ;; while mappings still exist. - [#'delete-upload-sessions! - #'delete-profiles! - #'delete-file-media-objects! - #'delete-file-object-thumbnails! - #'delete-file-thumbnails! - #'delete-file-data! - #'delete-file-changes! - #'delete-files! - #'delete-projects! - #'delete-fonts! - #'delete-teams!]) - -(defn- execute-proc! - "A generic function that executes the specified proc iterativelly - until 0 results is returned" - [cfg proc-fn] - (loop [total 0] - (let [result (db/tx-run! cfg - (fn [{:keys [::db/conn] :as cfg}] - (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) - (proc-fn cfg)))] - (if (pos? result) - (recur (long (+ total result))) - total)))) +(defn- delete-file-changes + [{:keys [::timestamp ::chunk-size] :as cfg}] + (let [rf (fn ([total] total) + ([total chunk] (+ total (delete-file-changes-chunk cfg chunk))))] + (db/tx-run! (assoc cfg ::db/read-only true) + (fn [{:keys [::db/conn]}] + (transduce (comp (map :id) (partition-all chunk-size)) rf 0 + (db/plan conn [sql:get-file-change timestamp] + {:fetch-size 5})))))) (defmethod ig/assert-key ::handler [_ params] @@ -383,11 +670,19 @@ (assoc ::chunk-size chunk-size) (assoc ::timestamp (if skip-delay (ct/in-future {:days 3650}) - (ct/now))))] - (loop [procs (map deref deletion-proc-vars) - total 0] - (if-let [proc-fn (first procs)] - (let [result (execute-proc! cfg proc-fn)] - (recur (rest procs) - (long (+ total result)))) - {:processed total}))))) + (ct/now)))) + ;; NOTE: upload sessions go first: deleting a profile cascades to its + ;; sessions, which would hit the upload_session_chunk NO ACTION foreign key + ;; while mappings still exist. + total (+ (delete-upload-sessions cfg) + (delete-profiles cfg) + (delete-file-media-objects cfg) + (delete-file-object-thumbnails cfg) + (delete-file-thumbnails cfg) + (delete-file-data cfg) + (delete-file-changes cfg) + (delete-files cfg) + (delete-projects cfg) + (delete-fonts cfg) + (delete-teams cfg))] + {:processed total}))) diff --git a/backend/test/backend_tests/climit_test.clj b/backend/test/backend_tests/climit_test.clj new file mode 100644 index 0000000000..c0d82344ef --- /dev/null +++ b/backend/test/backend_tests/climit_test.clj @@ -0,0 +1,692 @@ +;; 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 INC Sucursal en España SL + +(ns backend-tests.climit-test + (:require + [app.common.logging :as l] + [app.common.uuid :as uuid] + [app.main :as main] + [app.metrics :as mtx] + [app.rpc :as-alias rpc] + [app.rpc.climit :as climit] + [app.util.services :as-alias sv] + [backend-tests.helpers :as th] + [clojure.edn :as edn] + [clojure.java.io :as io] + [clojure.test :as t] + [integrant.core :as ig])) + +(def ^:private calls (atom [])) + +(defn- record-metrics + "Run `f` recording every metrics call it makes." + [f] + (reset! calls []) + (with-redefs [mtx/run! + (fn [_ & {:keys [id labels val]}] + (swap! calls conj {:id id :labels (vec labels) :val val}))] + (f))) + +(defn- acquired-in-order + "Limiter names acquired so far, in acquisition order." + [] + (->> @calls + (filter #(= :rpc-climit-timing (:id %))) + (mapcat :labels) + (vec))) + +(defn- saw-call? + "Wait until a metrics call mentions `label`." + [label timeout] + (let [deadline (+ (System/currentTimeMillis) timeout)] + (loop [] + (cond + (some (fn [call] (some #{label} (:labels call))) @calls) + true + + (> (System/currentTimeMillis) deadline) + false + + :else + (do (Thread/sleep 10) (recur)))))) + +(defn- failed-type + "Run `f` and return its value, or the type of the error it raised." + [f] + (try + (f) + (catch Throwable cause + (:type (ex-data cause))))) + +(def ^:private no-timeout-hint + "limiter without timeout, a saturated one parks its threads forever") + +(defn- warned-ids + "Ids of the captured log records that warn about a missing timeout." + [records] + (->> records + (keep (fn [record] + (when (= no-timeout-hint (get (::l/props record) :hint)) + (get (::l/props record) :id)))) + (set))) + +(defn- warned? + "Wait until a captured log record warns about a missing timeout." + [records timeout] + (let [deadline (+ (System/currentTimeMillis) timeout)] + (loop [] + (cond + (seq (warned-ids @records)) true + (> (System/currentTimeMillis) deadline) false + :else (do (Thread/sleep 10) (recur)))))) + +;; One permit and a bounded wait per limiter: a call either gets its permit, or +;; fails with a concurrency limit error, never parks a thread forever. +(def ^:private test-config + {:root/global {:permits 1 :timeout 3000} + :root/by-profile {:permits 1 :timeout 3000} + :process-image/global {:permits 1 :timeout 3000} + :process-image/by-profile {:permits 1 :timeout 3000}}) + +;; The limits `upload-file-media-object` and `assemble-file-media-object` +;; declare, per profile. +(def ^:private image-limits + [[:process-image/by-profile ::rpc/profile-id] + [:process-image/global]]) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ACQUISITION ORDER +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest acquires-root-limits-before-the-command-own-limits + ;; A command declaring its own limits must meet the root limiters first. + ;; The nested `climit/invoke!` calls take only the command's own limits and + ;; run inside the root ones, so any other order lets two calls of the same + ;; profile hold the same limiters in opposite order and park for good. + (record-metrics + (fn [] + (th/with-climit [climit test-config] + (let [mdata {::sv/name "test-command" ::climit/id image-limits} + wrapped (climit/wrap {::rpc/climit climit} (fn [_ _] :ok) mdata) + result (wrapped {::rpc/climit climit} {::rpc/profile-id (uuid/next)})] + (t/is (= :ok result)) + (t/is (= ["root/by-profile" + "root/global" + "process-image/by-profile" + "process-image/global"] + (acquired-in-order)))))))) + +(t/deftest nested-limits-do-not-deadlock-with-the-command-own-limits + ;; Two paths over one profile: a command declaring its own limits (like + ;; `upload-file-media-object`) and a command that takes the root limiters and + ;; then asks for the same limits from inside its handler (like + ;; `create-file-media-object-from-url`). Each path holds what the other one + ;; waits for the moment the order differs, and nothing releases. + (record-metrics + (fn [] + (th/with-climit [climit test-config] + (let [pid (uuid/next) + gate (promise) + entered (promise) + + handler-b (fn [cfg params] + (deliver entered true) + @gate + (-> cfg + (assoc ::climit/id [[:process-image/by-profile pid] + [:process-image/global]]) + (assoc ::climit/label "path-b") + (climit/invoke! (fn [_ _] :nested-ok) params))) + + wrapped-a (climit/wrap {::rpc/climit climit} + (fn [_ _] :ok) + {::sv/name "path-a" ::climit/id image-limits}) + + wrapped-b (climit/wrap {::rpc/climit climit} + handler-b + {::sv/name "path-b"})] + + ;; Path B takes the root limiters and waits inside its handler. + (let [fb (future (failed-type #(wrapped-b {::rpc/climit climit} + {::rpc/profile-id pid})))] + (t/is (true? (deref entered 5000 false))) + + ;; Path A, started now, takes its own limiters and then waits for the + ;; root ones, which B holds. The recorded metrics are how the test + ;; knows A got that far instead of guessing with a sleep. + (reset! calls []) + (let [fa (future (failed-type #(wrapped-a {::rpc/climit climit} + {::rpc/profile-id pid})))] + (t/is (true? (saw-call? "root/by-profile" 5000))) + + ;; Let B ask for the limits A holds: if the order differs, each path + ;; now waits for a permit the other one holds. + (deliver gate true) + + (t/is (= :ok (deref fa 15000 :timeout))) + (t/is (= :nested-ok (deref fb 15000 :timeout)))))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; REENTRANCY +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest reentrant-invoke-does-not-consume-a-second-permit + ;; A handler entering climit for a limit it already holds must not queue + ;; behind itself: it runs inline and takes no second permit. Another thread + ;; asking for the same limiter still waits, so the limit stays in place. + (th/with-climit [climit {:process-image/by-profile + {:permits 1 :timeout 2000}}] + (let [pid (uuid/next) + cfg {::rpc/climit climit + ::climit/id [[:process-image/by-profile pid]]} + inner (promise) + other (promise) + handler (fn [cfg params] + (deliver inner + (failed-type #(climit/invoke! cfg (fn [_ _] :inner-ok) params))) + (deliver other (future (climit/invoke! cfg (fn [_ _] :other-ok) params))) + (t/is (= :waiting (deref @other 300 :waiting))) + :outer-ok) + + outcome (failed-type #(climit/invoke! cfg handler {}))] + + ;; With no reentrancy handling the inner call waits for the permit this very + ;; thread holds and ends failing by timeout. + (t/is (= :inner-ok (deref inner 5000 :timeout))) + (t/is (= :outer-ok outcome)) + + ;; once the outer call releases, the other thread gets its permit + (t/is (= :other-ok (deref @other 5000 :timeout)))))) + +(t/deftest reentrant-tracking-is-cleaned-up-when-the-handler-fails + ;; If the mark is not removed, the thread keeps believing it holds the + ;; limiter and every later call of that key would skip the limit. + (th/with-climit [climit {:process-image/by-profile + {:permits 1 :timeout 1000}}] + (let [pid (uuid/next) + cfg {::rpc/climit climit + ::climit/id [[:process-image/by-profile pid]]} + holding (promise) + gate (promise)] + + ;; The failing call runs on this thread, so this thread is the one that + ;; must forget it held the limiter. + (t/is (thrown? clojure.lang.ExceptionInfo + (climit/invoke! cfg (fn [_ _] (throw (ex-info "boom" {}))) {}))) + + ;; another thread takes the only permit + (let [fb (future (climit/invoke! cfg (fn [_ _] + (deliver holding true) + @gate + :held) + {}))] + (t/is (true? (deref holding 5000 false))) + + ;; this thread must wait for it, not skip the limiter + (t/is (= :concurrency-limit + (failed-type #(climit/invoke! cfg (fn [_ _] :inner-ok) {})))) + + (deliver gate true) + (t/is (= :held (deref fb 5000 :timeout))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; SHIPPED CONFIG +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest example-config-bounds-every-wait + ;; A limiter without `:timeout` parks the calling thread forever, which is + ;; how a limit nobody releases turns into lost worker threads and days of + ;; silent 429s. Every entry of the shipped config must carry one. + (let [path (io/resource "climit.edn")] + (t/is (some? path)) + (let [data (edn/read-string (slurp path))] + (t/is (seq data)) + (doseq [[id config] data] + (t/is (int? (:timeout config)) + (str id " must declare a timeout")))))) + +(t/deftest warns-when-a-limiter-has-no-timeout + ;; The config that production loads lives outside the repository and is + ;; maintained by hand, so a limiter without a timeout has to say so at + ;; startup instead of parking threads in silence months later. + (let [records (atom [])] + (add-watch l/log-record ::capture + (fn [_ _ _ record] (swap! records conj record))) + (try + (th/with-climit [_climit {:process-image/by-profile {:permits 1 :timeout 1000} + :process-image/global {:permits 8}}] + (t/is (true? (warned? records 2000))) + (t/is (= #{:process-image/global} (warned-ids @records)))) + + (finally + (remove-watch l/log-record ::capture))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; WAITING COUNTER +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- waiting-value-of + "Values published to the waiting gauge for one limiter name, in order." + [name] + (->> @calls + (filter #(= :rpc-climit-waiting (:id %))) + (filter #(= name (first (:labels %)))) + (map :val) + (vec))) + +(defn- waiting-last + "Last value published to the waiting gauge for one limiter name. How many + publications land inside a window is not part of the contract, the value is, + so this is what the assertions read." + [name] + (last (waiting-value-of name))) + +(defn- waiting-count + "Current waiting count of a limiter name, read from its component." + [climit name] + (.get ^java.util.concurrent.atomic.AtomicLong + (#'climit/waiting-counter (:counters climit) name))) + +(defn- wait-until + "Wait until `pred` holds, or give up." + [pred timeout] + (let [deadline (+ (System/currentTimeMillis) timeout)] + (loop [] + (cond + (pred) true + (> (System/currentTimeMillis) deadline) false + :else (do (Thread/sleep 10) (recur)))))) + +(defn- limiter-name + "The name climit publishes for a limiter id: the keyword without the colon." + [id] + (subs (str id) 1)) + +(defn- limiter-cfg + [climit name key] + {::rpc/climit climit + ::climit/id [[name key]]}) + +(t/deftest waiting-gauge-follows-the-queue + ;; The value is the number of calls waiting for a permit: up when a call + ;; starts waiting, down when the wait ends. The gauges that sampled the + ;; limiter stats could not show this, because the value of whichever limiter + ;; of the name ran last was the one that survived. + (record-metrics + (fn [] + (th/with-climit [climit {:test-waiting/by-profile {:permits 1 :timeout 3000}}] + (let [name (limiter-name :test-waiting/by-profile) + entered (promise) + gate (promise) + holder (future (climit/invoke! (limiter-cfg climit :test-waiting/by-profile "a") + (fn [_ _] (deliver entered true) @gate :held) + {}))] + + (t/is (true? (deref entered 5000 false))) + + ;; the holder is running, not waiting + (reset! calls []) + (let [waiter (future (climit/invoke! (limiter-cfg climit :test-waiting/by-profile "a") + (fn [_ _] :waited) + {}))] + (t/is (true? (wait-until #(= 1 (waiting-last name)) 5000))) + (t/is (= 1 (waiting-count climit name))) + + (deliver gate true) + (t/is (= :waited (deref waiter 5000 :timeout))) + (t/is (= :held (deref holder 5000 :timeout))) + (t/is (true? (wait-until #(= 0 (waiting-last name)) 5000))) + (t/is (= 0 (waiting-count climit name))))))))) + +(t/deftest waiting-gauge-sums-every-key-of-a-name + ;; Two profiles queueing on the same limiter name add up. That is the shape + ;; that stayed invisible in production: one series per name, counting the + ;; entries and the exits, instead of one value per limiter overwritten by the + ;; next one. + (record-metrics + (fn [] + (th/with-climit [climit {:test-waiting-keys/by-profile {:permits 1 :timeout 3000}}] + (let [name (limiter-name :test-waiting-keys/by-profile) + gates {:a (promise) :b (promise)} + holders + (into {} + (map (fn [k] + (let [entered (promise)] + [k {:entered entered + :future (future (climit/invoke! (limiter-cfg climit :test-waiting-keys/by-profile k) + (fn [_ _] + (deliver entered true) + @(gates k) + :held) + {}))}]))) + [:a :b])] + + (doseq [k [:a :b]] + (t/is (true? (deref (:entered (holders k)) 5000 false)))) + + ;; one call per key, waiting behind its own holder + (let [waiters (into {} + (map (fn [k] + [k (future (climit/invoke! (limiter-cfg climit :test-waiting-keys/by-profile k) + (fn [_ _] :waited) + {}))])) + [:a :b])] + + (t/is (true? (wait-until #(= 2 (waiting-count climit name)) 5000))) + ;; the increment that reaches 2 always publishes 2, whichever waiter + ;; does it last: the order of two concurrent publications is not the + ;; contract, the value is. + (t/is (some #(= 2 %) (waiting-value-of name))) + + (doseq [k [:a :b]] (deliver (gates k) true)) + + (doseq [k [:a :b]] + (t/is (= :waited (deref (waiters k) 5000 :timeout))) + (t/is (= :held (deref (:future (holders k)) 5000 :timeout)))) + + (t/is (true? (wait-until #(= 0 (waiting-count climit name)) 5000))) + (t/is (some #(= 0 %) (waiting-value-of name))))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; REJECTIONS +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- rejections + "Rejections published, as [name reason] pairs." + [] + (->> @calls + (filter #(= :rpc-climit-rejected (:id %))) + (map (fn [call] [(first (:labels call)) (second (:labels call))])) + (vec))) + +(t/deftest rejection-counter-tells-why + ;; Rejections had no metric: the panel counted them from the logs. Now a call + ;; rejected because the queue is full and a call rejected because it waited + ;; too long are counted apart. + (record-metrics + (fn [] + (th/with-climit [climit {:test-rejected/by-profile {:permits 1 :queue 1 :timeout 60000}}] + (let [name (limiter-name :test-rejected/by-profile) + cfg (limiter-cfg climit :test-rejected/by-profile "a") + entered (promise) + gate (promise) + holder (future (climit/invoke! cfg + (fn [_ _] (deliver entered true) @gate :held) + {}))] + + (t/is (true? (deref entered 5000 false))) + (reset! calls []) + + ;; the queue holds one waiter, so the next call is rejected right away + (let [queued (future (failed-type #(climit/invoke! cfg (fn [_ _] :queued) {})))] + (t/is (true? (wait-until #(= 1 (waiting-last name)) 5000))) + (t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :extra) {})))) + (t/is (= [[name "queue-full"]] (rejections))) + + (deliver gate true) + (t/is (= :held (deref holder 5000 :timeout))) + (t/is (= :queued (deref queued 5000 :timeout)))))) + + ;; a wait that times out is counted as such, not as a full queue + (th/with-climit [climit {:test-timeout/by-profile {:permits 1 :timeout 300}}] + (let [name (limiter-name :test-timeout/by-profile) + cfg (limiter-cfg climit :test-timeout/by-profile "a") + entered (promise) + gate (promise) + holder (future (climit/invoke! cfg + (fn [_ _] (deliver entered true) @gate :held) + {}))] + + (t/is (true? (deref entered 5000 false))) + (reset! calls []) + (t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :late) {})))) + (t/is (= [[name "timeout"]] (rejections))) + + (deliver gate true) + (t/is (= :held (deref holder 5000 :timeout)))))))) + +(t/deftest the-waiting-count-comes-back-after-a-rejection + ;; A rejected call increments and decrements exactly once: a limiter that + ;; rejects under pressure must not drift the panel up. + (record-metrics + (fn [] + (th/with-climit [climit {:test-rejected-baseline/by-profile {:permits 1 :queue 0 :timeout 3000}}] + (let [name (limiter-name :test-rejected-baseline/by-profile) + cfg (limiter-cfg climit :test-rejected-baseline/by-profile "a") + entered (promise) + gate (promise) + holder (future (climit/invoke! cfg + (fn [_ _] (deliver entered true) @gate :held) + {}))] + + (t/is (true? (deref entered 5000 false))) + (reset! calls []) + + (t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :extra) {})))) + (t/is (= 0 (waiting-count climit name))) + (t/is (true? (wait-until #(= 0 (waiting-last name)) 5000))) + + (deliver gate true) + (t/is (= :held (deref holder 5000 :timeout)))))))) + +(t/deftest the-waiting-count-comes-back-when-the-handler-throws + ;; A handler that throws still leaves the count where it was. + (record-metrics + (fn [] + (th/with-climit [climit {:test-handler-throws/by-profile {:permits 1 :timeout 3000}}] + (let [name (limiter-name :test-handler-throws/by-profile) + cfg (limiter-cfg climit :test-handler-throws/by-profile "a")] + + (reset! calls []) + (t/is (thrown? clojure.lang.ExceptionInfo + (climit/invoke! cfg (fn [_ _] (throw (ex-info "boom" {}))) {}))) + + (t/is (= 0 (waiting-count climit name))) + (t/is (true? (wait-until #(= 0 (waiting-last name)) 5000)))))))) + +(defn- failing-first-waiting-publish + "A `mtx/run!` replacement that fails the first waiting publication and records + the rest, so the decrement of the unwinding path still lands." + [calls] + (let [pending (atom true)] + (fn [_ & {:keys [id labels val]}] + (if (and @pending (= :rpc-climit-waiting id)) + (do (reset! pending false) + (throw (ex-info "publishing is down" {}))) + (swap! calls conj {:id id :labels (vec labels) :val val}))))) + +(t/deftest a-throwable-while-waiting-leaves-no-mark-and-no-count + ;; `waiting-inc` sits inside the `try`: a throwable from the publishing path + ;; unwinds through the `finally`, so the thread neither keeps the limiter + ;; marked as held (it would skip that limiter for that key for ever) nor + ;; leaves the count up. + (th/with-climit [climit {:test-throw-waiting/by-profile {:permits 1 :timeout 3000}}] + (let [name (limiter-name :test-throw-waiting/by-profile) + cfg (limiter-cfg climit :test-throw-waiting/by-profile "a")] + + (reset! calls []) + (with-redefs [mtx/run! (failing-first-waiting-publish calls)] + (t/is (thrown? clojure.lang.ExceptionInfo + (climit/invoke! cfg (fn [_ _] :never) {})))) + + ;; the count came back down instead of staying up for good + (t/is (= 0 (waiting-count climit name))) + (t/is (= [0] (waiting-value-of name))) + + ;; and the thread dropped the mark: with it left behind, this call would + ;; run inline instead of waiting for the permit another thread holds. + (let [entered (promise) + gate (promise) + holder (future (climit/invoke! cfg + (fn [_ _] (deliver entered true) @gate :held) + {}))] + (t/is (true? (deref entered 5000 false))) + (t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :inline) {})))) + (deliver gate true) + (t/is (= :held (deref holder 5000 :timeout))))))) + +(defn- gauge-value + "Current value of the waiting gauge for one limiter name, read from a real + prometheus collector." + [metrics name] + (let [collector (:app.metrics.definition/instance + (mtx/get-collector metrics :rpc-climit-waiting))] + (.get ^io.prometheus.client.Gauge$Child + (.labels ^io.prometheus.client.Gauge collector (into-array String [name]))))) + +(t/deftest the-waiting-gauge-reaches-a-real-registry + ;; The recorded calls prove the arguments, not that a collector with that name + ;; and those labels exists: a typo in the metric id or a wrong label arity + ;; would only show up in production. Here the value is read back from a real + ;; prometheus registry. + (let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics}) + name (limiter-name :test-registry/by-profile)] + + (th/with-climit [climit {:test-registry/by-profile {:permits 1 :timeout 3000}} metrics] + (let [cfg (limiter-cfg climit :test-registry/by-profile "a") + entered (promise) + gate (promise) + holder (future (climit/invoke! cfg + (fn [_ _] (deliver entered true) @gate :held) + {}))] + + (t/is (true? (deref entered 5000 false))) + + (let [waiter (future (climit/invoke! cfg (fn [_ _] :waited) {}))] + (t/is (true? (wait-until #(= 1.0 (gauge-value metrics name)) 5000))) + (deliver gate true) + (t/is (= :waited (deref waiter 5000 :timeout))) + (t/is (= :held (deref holder 5000 :timeout))) + (t/is (true? (wait-until #(= 0.0 (gauge-value metrics name)) 5000)))))))) + +(defn- rejected-record + "The first captured log record that reports a rejection with `reason`." + [records reason] + (let [deadline (+ (System/currentTimeMillis) 5000)] + (loop [] + (let [record (first (filter (fn [record] + (let [props (::l/props record)] + (and (= "rejected" (get props :hint)) + (= reason (get props :reason))))) + @records))] + (cond + record record + (> (System/currentTimeMillis) deadline) nil + :else (do (Thread/sleep 10) (recur))))))) + +(t/deftest rejection-logs-say-why-and-how-big-the-limits-are + ;; The line has to say whether the queue was full or the wait timed out, and + ;; how many permits and how much queue the limiter has, or nobody can tell + ;; whether the limiter did its job. + (let [records (atom [])] + (add-watch l/log-record ::capture + (fn [_ _ _ record] (swap! records conj record))) + (try + (record-metrics + (fn [] + (th/with-climit [climit {:test-log/by-profile {:permits 1 :queue 2 :timeout 60000}}] + (let [name (limiter-name :test-log/by-profile) + cfg (limiter-cfg climit :test-log/by-profile "a") + entered (promise) + gate (promise) + holder (future (climit/invoke! cfg + (fn [_ _] (deliver entered true) @gate :held) + {}))] + + (t/is (true? (deref entered 5000 false))) + (reset! calls []) + + (let [q1 (future (climit/invoke! cfg (fn [_ _] :q1) {})) + q2 (future (climit/invoke! cfg (fn [_ _] :q2) {}))] + + ;; the two of them fill the queue, so the next one is rejected + (t/is (true? (wait-until #(= 2 (waiting-count climit name)) 5000))) + (t/is (some #(= 2 %) (waiting-value-of name))) + (t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :x) {})))) + + (let [props (::l/props (rejected-record records "queue-full"))] + (t/is (= 1 (get props :permits))) + (t/is (= 2 (get props :queue-max))) + (t/is (= :capacity-limit-reached (get props :code))) + (t/is (= "queue-full" (get props :reason)))) + + (deliver gate true) + (t/is (= :held (deref holder 5000 :timeout))) + (deref q1 5000 nil) + (deref q2 5000 nil)))) + + ;; A wait that times out carries its own reason in the line, next to the + ;; code the limiter raised. The line is emitted at TRACE when nothing + ;; else is left queued behind it (the caller was the only one waiting), + ;; so the call to `log` is captured instead of the record, which the + ;; logger would drop. + (th/with-climit [climit {:test-log-timeout/by-profile {:permits 1 :timeout 300}}] + (let [cfg (limiter-cfg climit :test-log-timeout/by-profile "a") + lines (atom []) + entered (promise) + gate (promise) + capture (fn [_ action _req-id _stats _elapsed code reason] + (swap! lines conj [action code reason])) + holder (future (climit/invoke! cfg + (fn [_ _] (deliver entered true) @gate :held) + {}))] + + (t/is (true? (deref entered 5000 false))) + + (with-redefs [climit/log capture] + (t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :late) {})))) + (t/is (= [["rejected" :capacity-limit-reached "timeout"]] + (filterv #(= "rejected" (first %)) @lines)))) + + (deliver gate true) + (t/is (= :held (deref holder 5000 :timeout))))))) + + (finally + (remove-watch l/log-record ::capture))))) + +(t/deftest republish-writes-the-current-waiting-count + ;; A call that never comes back keeps the count up, but if it is also the + ;; last thing that happened nothing rewrites that series and it goes stale in + ;; the scrape. The republish is what keeps it visible. + (th/with-climit [climit {:test-republish/by-profile {:permits 1 :timeout 3000}}] + (let [name (limiter-name :test-republish/by-profile)] + + (.set ^java.util.concurrent.atomic.AtomicLong + (#'climit/waiting-counter (:counters climit) name) + 3) + + (record-metrics + (fn [] + (#'climit/republish-waiting (th/metrics-stub) (:counters climit)) + (t/is (= [3] (waiting-value-of name)))))))) + +(t/deftest halting-the-component-stops-the-republisher + ;; The republisher is a daemon thread started with the component: halting it + ;; has to stop the thread, or every restart leaves another one running. + (let [climit (th/init-climit {:test-halt/by-profile {:permits 1 :timeout 3000}}) + sampler ^java.util.concurrent.ScheduledThreadPoolExecutor (:sampler climit)] + + (t/is (false? (.isShutdown sampler))) + + (ig/halt-key! ::rpc/climit climit) + + (t/is (true? (.isShutdown sampler))))) + +(t/deftest the-climit-metrics-that-remain-are-defined + ;; A typo in a metric id, or a definition that is not there, makes the + ;; publishing silent, which is the failure mode this work removes. And the + ;; gauges that could not tell the truth must be gone. + (let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})] + + (t/is (= ["name"] + (:app.metrics.definition/labels (mtx/get-collector metrics :rpc-climit-waiting)))) + (t/is (= ["name" "reason"] + (:app.metrics.definition/labels (mtx/get-collector metrics :rpc-climit-rejected)))) + (t/is (some? (mtx/get-collector metrics :rpc-climit-timing))) + + (t/is (nil? (mtx/get-collector metrics :rpc-climit-queue))) + (t/is (nil? (mtx/get-collector metrics :rpc-climit-permits))) + (t/is (nil? (mtx/get-collector metrics :http-worker-busy-threads))))) diff --git a/backend/test/backend_tests/health_test.clj b/backend/test/backend_tests/health_test.clj new file mode 100644 index 0000000000..c8e0c56bcc --- /dev/null +++ b/backend/test/backend_tests/health_test.clj @@ -0,0 +1,81 @@ +;; 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 INC Sucursal en España SL + +(ns backend-tests.health-test + (:require + [app.common.exceptions :as ex] + [app.db :as db] + [app.health :as health] + [app.http.debug :as debug] + [app.srepl.main :as srepl] + [backend-tests.helpers :as th] + [clojure.test :as t] + [yetti.response :as-alias yres])) + +(t/use-fixtures :once th/state-init) + +(defn- restore-availability + "The availability flag is a global atom shared by the whole test JVM, so + every test leaves the instance online." + [next] + (try + (next) + (finally + (health/set-online)))) + +(t/use-fixtures :each (th/serial th/database-reset restore-availability)) + +;; ---------------------------------------------------------------- +;; Tests: app.health state +;; ---------------------------------------------------------------- + +(t/deftest instance-is-online-by-default + (t/is (true? (health/online?)))) + +(t/deftest set-offline-and-set-online-toggle-the-flag + (health/set-offline) + (t/is (false? (health/online?))) + + (health/set-online) + (t/is (true? (health/online?)))) + +;; ---------------------------------------------------------------- +;; Tests: /readyz handler +;; ---------------------------------------------------------------- + +(t/deftest readyz-reports-ok-when-instance-is-online + (let [response (debug/health-handler th/*system* {})] + (t/is (= 200 (::yres/status response))) + (t/is (= "OK" (::yres/body response))))) + +(t/deftest readyz-reports-unavailable-when-instance-is-offline + (health/set-offline) + (let [response (debug/health-handler th/*system* {})] + (t/is (= 503 (::yres/status response))) + (t/is (= "OFFLINE" (::yres/body response))))) + +(t/deftest readyz-does-not-query-the-database-when-instance-is-offline + (health/set-offline) + (with-redefs [db/exec-one! (fn [_ _] + (throw (ex-info "database unreachable" {})))] + (let [response (debug/health-handler th/*system* {})] + (t/is (= 503 (::yres/status response))) + (t/is (= "OFFLINE" (::yres/body response)))))) + +;; ---------------------------------------------------------------- +;; Tests: srepl helpers (the operator entry points) +;; ---------------------------------------------------------------- + +(t/deftest srepl-helpers-change-the-readyz-answer + (srepl/set-offline) + (let [drained (debug/health-handler th/*system* {})] + (t/is (= 503 (::yres/status drained))) + (t/is (= "OFFLINE" (::yres/body drained)))) + + (srepl/set-online) + (let [restored (debug/health-handler th/*system* {})] + (t/is (= 200 (::yres/status restored))) + (t/is (= "OK" (::yres/body restored))))) diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj index a32d4facb8..2718e48615 100644 --- a/backend/test/backend_tests/helpers.clj +++ b/backend/test/backend_tests/helpers.clj @@ -23,9 +23,11 @@ [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] @@ -515,6 +517,40 @@ (assoc :app.worker.runner/id 0))] (#'app.worker.runner/run-task cfg task))))))) +(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! diff --git a/backend/test/backend_tests/http_metrics_test.clj b/backend/test/backend_tests/http_metrics_test.clj index 4e56b67f22..07ea991843 100644 --- a/backend/test/backend_tests/http_metrics_test.clj +++ b/backend/test/backend_tests/http_metrics_test.clj @@ -16,7 +16,6 @@ io.prometheus.client.Counter io.prometheus.client.Gauge io.undertow.server.ConnectorStatistics - java.util.concurrent.ScheduledThreadPoolExecutor org.xnio.management.XnioWorkerMXBean)) (t/use-fixtures :once th/state-init) @@ -29,9 +28,6 @@ {:http-worker-queue-size {:name "penpot_http_worker_queue_size" :help "test" :type :gauge} - :http-worker-busy-threads {:name "penpot_http_worker_busy_threads" - :help "test" - :type :gauge} :http-worker-pool-size {:name "penpot_http_worker_pool_size" :help "test" :type :gauge} @@ -132,23 +128,20 @@ (http/sample-worker-metrics metrics mxbean) (t/is (= 2.0 (gauge-value (collector-instance metrics :http-worker-queue-size)))) - (t/is (= 10.0 (gauge-value (collector-instance metrics :http-worker-busy-threads)))) (t/is (= 40.0 (gauge-value (collector-instance metrics :http-worker-pool-size)))) (t/is (= 512.0 (gauge-value (collector-instance metrics :http-worker-max-pool-size)))))) (t/deftest sample-worker-metrics-skips-negative-samples - ;; the xnio MXBean occasionally returns -1 on the busy thread count; - ;; a negative value is a missing measurement, not a zero. + ;; the xnio MXBean occasionally returns -1 on a count; a negative value is a + ;; missing measurement, not a zero. (let [metrics (fake-metrics) - mxbean (fake-mxbean {:queue 0 :busy -1 :pool 4 :max 512})] + mxbean (fake-mxbean {:queue -1 :busy -1 :pool 4 :max 512})] (http/sample-worker-metrics metrics mxbean) (t/is (= 0.0 (gauge-value (collector-instance metrics :http-worker-queue-size)))) (t/is (= 4.0 (gauge-value (collector-instance metrics :http-worker-pool-size)))) - (t/is (= 512.0 (gauge-value (collector-instance metrics :http-worker-max-pool-size)))) - (t/is (= 0.0 - (gauge-value (collector-instance metrics :http-worker-busy-threads)))))) + (t/is (= 512.0 (gauge-value (collector-instance metrics :http-worker-max-pool-size)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Test: connector metrics @@ -230,28 +223,3 @@ (finally (px/shutdown-now sampler) (t/is (px/shutdown? sampler)))))) - -(t/deftest create-metrics-sampler-reschedules-after-error - ;; the docstring promise: an unexpected error on a single sample must - ;; not cancel the following runs. The first sample runs immediately - ;; and throws; the next one must still be scheduled afterwards. - (let [calls (atom 0)] - (with-redefs [http/sample-http-metrics (fn [_ _ _] - (swap! calls inc) - (throw (ex-info "boom" {})))] - (let [sampler (http/create-metrics-sampler nil (fake-metrics)) - queue (.getQueue ^ScheduledThreadPoolExecutor sampler)] - (try - (t/is (loop [i 0] - (cond (pos? @calls) true - (> i 200) false - :else (do (Thread/sleep 10) (recur (inc i))))) - "the first sample must run immediately") - - (t/is (loop [i 0] - (cond (= 1 (.size queue)) true - (> i 200) false - :else (do (Thread/sleep 10) (recur (inc i))))) - "the next sample must be scheduled after the error") - (finally - (px/shutdown-now sampler))))))) diff --git a/backend/test/backend_tests/metrics_test.clj b/backend/test/backend_tests/metrics_test.clj index 5365ce1932..77a7c561b2 100644 --- a/backend/test/backend_tests/metrics_test.clj +++ b/backend/test/backend_tests/metrics_test.clj @@ -9,11 +9,13 @@ [app.metrics :as mtx] [app.metrics.definition :as-alias mdef] [clojure.test :as t] - [integrant.core :as ig]) + [integrant.core :as ig] + [promesa.exec :as px]) (:import io.prometheus.client.Collector$MetricFamilySamples io.prometheus.client.Collector$MetricFamilySamples$Sample - io.prometheus.client.CollectorRegistry)) + io.prometheus.client.CollectorRegistry + java.util.concurrent.ScheduledThreadPoolExecutor)) (def ^:private valid-definitions? @#'app.metrics/valid-definitions?) @@ -118,3 +120,28 @@ ::mdef/help "typo check" ::mdef/type :histogram ::mdef/bucksets [100]}})))) + +(t/deftest create-sampler-reschedules-after-error + ;; The docstring promise, tested once for both call sites: an unexpected error + ;; on a single sample must not cancel the following runs. The first sample + ;; runs immediately and throws; the next one must still be scheduled. + (let [calls (atom 0) + sampler (mtx/create-sampler 1000 (fn [] + (swap! calls inc) + (throw (ex-info "boom" {}))))] + (try + (t/is (loop [i 0] + (cond (pos? @calls) true + (> i 200) false + :else (do (Thread/sleep 10) (recur (inc i))))) + "the first sample must run immediately") + + (let [queue (.getQueue ^ScheduledThreadPoolExecutor sampler)] + (t/is (loop [i 0] + (cond (= 1 (.size queue)) true + (> i 200) false + :else (do (Thread/sleep 10) (recur (inc i))))) + "the next sample must be scheduled after the error")) + + (finally + (px/shutdown-now sampler))))) diff --git a/backend/test/backend_tests/objects_gc_test.clj b/backend/test/backend_tests/objects_gc_test.clj new file mode 100644 index 0000000000..f02a437f4f --- /dev/null +++ b/backend/test/backend_tests/objects_gc_test.clj @@ -0,0 +1,125 @@ +;; 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 INC Sucursal en España SL + +(ns backend-tests.objects-gc-test + (:require + [app.common.logging :as l] + [app.common.time :as ct] + [app.db :as db] + [app.storage :as sto] + [app.tasks.objects-gc :as ogc] + [backend-tests.helpers :as th] + [clojure.test :as t])) + +(t/use-fixtures :once th/state-init) +(t/use-fixtures :each th/database-reset) + +(defn- create-deleted-file! + "Creates a file and applies the deletion cascade on it (the same task the RPC + uses), so its children are marked as deleted for the given date. Returns the + file." + [profile i deleted-at] + (let [file (th/create-file* i {:profile-id (:id profile) + :project-id (:default-project-id profile)})] + (th/run-task! :delete-object {:object :file + :deleted-at deleted-at + :id (:id file)}) + file)) + +(defn- block-file! + "Leaves an unmarked `file_media_object` pointing at the file, which is what + happens in production: a child that the deletion cascade did not mark. Its + foreign key towards `file` is `NO ACTION`, so it blocks the file deletion." + [file] + (let [media (sto/put-object! (::sto/storage th/*system*) + {::sto/content (sto/content "media") + :content-type "text/plain" + :bucket "file-media-object"})] + (th/create-file-media-object* {:file-id (:id file) + :media-id (:id media)}))) + +(defn- find-file + [id] + (th/db-get :file {:id id} {::db/remove-deleted false})) + +(defn- chunk-error + "The first captured log record that reports a skipped chunk for `obj`, + waiting for it because logging is asynchronous." + [records obj] + (let [deadline (+ (System/currentTimeMillis) 5000)] + (loop [] + (let [record (first (filter (fn [record] + (let [props (::l/props record)] + (and (= obj (get props :obj)) + (= "error on chunk deletion, skipping it" + (get props :hint))))) + @records))] + (cond + record record + (> (System/currentTimeMillis) deadline) nil + :else (do (Thread/sleep 10) (recur))))))) + +(t/deftest deletes-the-pending-files + (let [profile (th/create-profile* 1) + file (create-deleted-file! profile 1 (ct/in-past "10m")) + result (th/run-task! :objects-gc {})] + + (t/is (pos? (:processed result))) + (t/is (nil? (find-file (:id file)))))) + +(t/deftest profile-cascade-keeps-profile-deletion-date + ;; The cascade marks the owned rows with the deletion date of the profile, + ;; like the RPC delete-profile flow does, not with the timestamp of the run. + ;; The team survives because only the profiles chunk runs here, so its row + ;; still shows that date. + (let [profile (th/create-profile* 1) + _ (th/db-update! :profile {:deleted-at (ct/in-past "30m")} {:id (:id profile)}) + + deleted-at (:deleted-at (th/db-get :profile {:id (:id profile)} + {::db/remove-deleted false})) + + cfg {::db/pool th/*pool* + ::sto/storage (::sto/storage th/*system*) + ::ogc/timestamp deleted-at} + total (#'ogc/delete-profiles-chunk cfg [(:id profile)])] + + (t/testing "the profile is gone and the chunk reports it" + (t/is (= 1 total)) + (t/is (nil? (th/db-get :profile {:id (:id profile)} {::db/remove-deleted false})))) + + (t/testing "the owned team keeps the deletion date of the profile" + (t/is (= deleted-at (:deleted-at (th/db-get :team {:id (:default-team-id profile)} + {::db/remove-deleted false}))))))) + +(t/deftest blocked-chunk-does-not-stop-the-run + ;; Chunks of one file: the blocked file takes down its own chunk and nothing + ;; else, so the clean file of the next chunk is still deleted and the run + ;; finishes. The next run retries the blocked file. + (let [profile (th/create-profile* 1) + blocked (create-deleted-file! profile 1 (ct/in-past "30m")) + clean (create-deleted-file! profile 2 (ct/in-past "20m")) + + _ (block-file! blocked) + + records (atom []) + _ (add-watch l/log-record ::capture + (fn [_ _ _ record] (swap! records conj record))) + result (try + (th/run-task! :objects-gc {:chunk-size 1}) + (finally + (remove-watch l/log-record ::capture)))] + + (t/testing "the clean file of the next chunk is deleted" + (t/is (nil? (find-file (:id clean))))) + + (t/testing "the blocked file is still pending" + (t/is (some? (find-file (:id blocked))))) + + (t/testing "the failed chunk is reported" + (t/is (some? (chunk-error records "file")))) + + (t/testing "the run finishes" + (t/is (pos? (:processed result)))))) diff --git a/backend/test/backend_tests/restore_storage_objects_test.clj b/backend/test/backend_tests/restore_storage_objects_test.clj new file mode 100644 index 0000000000..5545270648 --- /dev/null +++ b/backend/test/backend_tests/restore_storage_objects_test.clj @@ -0,0 +1,126 @@ +;; 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 INC Sucursal en España SL + +(ns backend-tests.restore-storage-objects-test + (:require + [app.common.time :as ct] + [app.common.uuid :as uuid] + [app.db :as db] + [app.rpc.commands.files :as files] + [app.srepl.main :as srepl] + [app.storage :as sto] + [app.system :as sys] + [backend-tests.helpers :as th] + [clojure.test :as t])) + +(t/use-fixtures :once th/state-init) +(t/use-fixtures :each th/database-reset) + +;; Restoring a file brings its rows back to life, so the storage objects those +;; rows reference must stop being marked for deletion: otherwise the storage GC +;; hits the foreign key and skips them forever. + +(defn- put-object! + [bucket] + (sto/put-object! (::sto/storage th/*system*) + {::sto/content (sto/content "sobject") + :content-type "text/plain" + :bucket bucket})) + +(defn- find-object + [id] + (th/db-get :storage-object {:id id} {::db/remove-deleted false})) + +(defn- mark-object! + [id] + (th/db-update! :storage-object {:deleted-at (ct/in-past {:days 1})} {:id id})) + +(defn- restore-file! + [file-id] + (db/tx-run! th/*system* + (fn [{:keys [::db/conn]}] + (#'files/restore-files conn [file-id])))) + +(t/deftest restoring-a-file-unmarks-the-objects-its-rows-reference + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile)}) + + ;; The media object's thumbnail points at an object of another bucket: + ;; that is the anomaly found in production. The marking task decides + ;; with the table of the object's bucket, so it does not see that + ;; reference and ends up marking an object that a live row still uses. + media-id (:id (put-object! "file-media-object")) + thumb-id (:id (put-object! "file-object-thumbnail")) + bystander (:id (put-object! "file-object-thumbnail")) + mobject (th/create-file-media-object* {:file-id (:id file) + :media-id media-id})] + + (th/db-update! :file-media-object + {:thumbnail-id thumb-id + :deleted-at (ct/in-past {:days 1})} + {:id (:id mobject)}) + + (t/testing "the fixture reproduces the anomaly" + (t/is (= "file-object-thumbnail" + (:bucket (meta (sto/get-object (::sto/storage th/*system*) thumb-id)))))) + + ;; The objects end up marked as deleted, as the marking task leaves them. + (mark-object! media-id) + (mark-object! thumb-id) + (mark-object! bystander) + + (restore-file! (:id file)) + + (t/testing "the objects referenced by the restored rows are alive again" + (t/is (nil? (:deleted-at (find-object media-id)))) + (t/is (nil? (:deleted-at (find-object thumb-id))))) + + (t/testing "objects of other rows are left alone" + (t/is (some? (:deleted-at (find-object bystander))))))) + +(t/deftest restoring-a-file-unmarks-the-objects-of-its-data + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile)}) + sobject (:id (put-object! "file-data")) + data-id (uuid/next)] + + (th/db-update! :file {:deleted-at (ct/in-past {:days 1})} {:id (:id file)}) + (th/db-insert! :file-data + {:file-id (:id file) + :id data-id + :type "main" + :backend "fs" + :deleted-at (ct/in-past {:days 1}) + :metadata (db/json {"storage-ref-id" (str sobject)})}) + (mark-object! sobject) + + (restore-file! (:id file)) + + (t/is (nil? (:deleted-at (find-object sobject)))))) + +(t/deftest restoring-a-team-unmarks-the-objects-of-its-fonts + (let [profile (th/create-profile* 1) + team (th/create-team* 1 {:profile-id (:id profile)}) + sobject (:id (put-object! "team-font-variant"))] + + (th/db-insert! :team-font-variant + {:id (uuid/next) + :team-id (:id team) + :profile-id (:id profile) + :font-id (uuid/next) + :font-family "somefont" + :font-weight 400 + :font-style "normal" + :deleted-at (ct/in-past {:days 1}) + :woff1-file-id sobject}) + (mark-object! sobject) + + (with-redefs [sys/system th/*system*] + (srepl/restore-team! (:id team))) + + (t/is (nil? (:deleted-at (find-object sobject)))))) diff --git a/backend/test/backend_tests/rpc_audit_test.clj b/backend/test/backend_tests/rpc_audit_test.clj index ab823e1d41..50ee79f2e8 100644 --- a/backend/test/backend_tests/rpc_audit_test.clj +++ b/backend/test/backend_tests/rpc_audit_test.clj @@ -13,6 +13,7 @@ [app.db :as db] [app.loggers.audit :as audit] [app.rpc :as-alias rpc] + [app.rpc.climit :as climit] [app.util.services :as sv] [backend-tests.helpers :as th] [clojure.test :as t] @@ -35,6 +36,48 @@ "x-forwarded-for" "127.0.0.44" "x-real-ip" "127.0.0.43")))) +(t/deftest push-audit-events-limit-is-keyed-by-profile + ;; Regression guard. This command asks for a per-profile limit, but it used + ;; to declare it as a plain keyword next to `::climit/key-fn`, metadata that + ;; `climit/wrap` does not read: it takes the key only from the positional + ;; `key-fn` of the vector form. That silently turned the limit into a single + ;; shared one, so one stuck call ended up rejecting the audit batches of + ;; every profile on the instance. Two profiles must not share a limiter. + (th/with-climit [climit {:submit-audit-events/by-profile + {:permits 1 :queue 1 :timeout 30000}}] + (let [;; The metadata declared by the command itself, that is what the test + ;; has to cover. + mdata (meta (ns-resolve 'app.rpc.commands.audit 'sm$push-audit-events)) + + gate (promise) + entered (promise) + calls (atom 0) + handler (fn [_ _] + (when (= 1 (swap! calls inc)) + (deliver entered true) + @gate) + :ok) + wrapped (climit/wrap {::rpc/climit climit} handler mdata) + call (fn [profile-id] + (wrapped {::rpc/climit climit} {::rpc/profile-id profile-id})) + pid-a (uuid/next) + pid-b (uuid/next) + holder (future (call pid-a))] + + ;; The first call stays inside the handler holding the only permit. + (t/is (true? (deref entered 2000 false))) + + ;; Another call from the SAME profile shares the limiter, so it waits. + (let [same (future (call pid-a))] + (t/is (= :waiting (deref same 300 :waiting)))) + + ;; A different profile owns a different limiter and is served right away. + ;; With the shared limiter (the bug) this one waits too and times out. + (t/is (= :ok (deref (future (call pid-b)) 2000 :timeout))) + + (deliver gate true) + (t/is (= :ok (deref holder 2000 :timeout)))))) + (t/deftest prepare-context-initiator-is-plain-string ;; The initiator must always be a plain string, never a keyword: shared-key ;; authenticated callers (exporter, admin-console) arrive as keywords on diff --git a/backend/test/backend_tests/rpc_climit_test.clj b/backend/test/backend_tests/rpc_climit_test.clj new file mode 100644 index 0000000000..b5b8e853d8 --- /dev/null +++ b/backend/test/backend_tests/rpc_climit_test.clj @@ -0,0 +1,51 @@ +;; 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 INC Sucursal en España SL + +(ns backend-tests.rpc-climit-test + (:require + [app.rpc.climit :as-alias climit] + [app.util.services :as-alias sv] + [backend-tests.helpers :as th] + [clojure.test :as t])) + +(t/use-fixtures :once th/state-init) + +(defn- method-limit-declarations + "The `::climit/id` declarations of every RPC command, as the running system + wraps them." + [] + (->> (:app.rpc/methods th/*system*) + (vals) + (map first) + (keep (fn [mdata] + (when-let [limits (::climit/id mdata)] + [mdata limits]))))) + +(t/deftest commands-declare-the-by-profile-limit-before-the-global-one + ;; `climit/get-limits` reverses a declared vector of pairs, so the first one + ;; declared is acquired first, and the nested `climit/invoke!` chains read the + ;; same declaration. A pair declared global first puts a command back in the + ;; inverted order that parked two paths of one profile for good. + (let [declarations (method-limit-declarations)] + + ;; the system wraps every command, so a short list means the scan went stale + (t/is (<= 10 (count declarations))) + + (doseq [[mdata limits] declarations + :when (and (vector? limits) (vector? (first limits)))] + (let [ids (mapv first limits) + index (into {} (map-indexed (fn [idx id] [id idx]) ids)) + where (str (::sv/name mdata))] + + (t/is (= (count ids) (count (distinct ids))) + (str where " declares the same limit twice")) + + (doseq [[id idx] index + :when (= "by-profile" (name id))] + (when-let [gidx (get index (keyword (namespace id) "global"))] + (t/is (< idx gidx) + (str where " must declare " id " before " + (keyword (namespace id) "global"))))))))) diff --git a/backend/test/backend_tests/srepl_main_test.clj b/backend/test/backend_tests/srepl_main_test.clj index 9897415d19..1e2add5361 100644 --- a/backend/test/backend_tests/srepl_main_test.clj +++ b/backend/test/backend_tests/srepl_main_test.clj @@ -2,13 +2,45 @@ ;; 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 +;; Copyright (c) KALEIDOS INC Sucursal en España SL (ns backend-tests.srepl-main-test (:require + [app.common.time :as ct] [app.srepl.main :as srepl] + [app.system :as sys] + [app.worker :as wrk] + [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- capture-submissions! + "Runs `f` with `wrk/submit!` replaced by a collector, and returns the option + maps it was called with, in order." + [f] + (let [submitted (atom [])] + (with-redefs [wrk/submit! (fn [opts] + (swap! submitted conj opts) + (get-in opts [::wrk/params :id]))] + (f)) + @submitted)) + +(defn- params-of + [submitted] + (mapv ::wrk/params submitted)) + +(defn- create-deleted-profile! + [i deleted-at] + (let [profile (th/create-profile* i)] + (th/db-update! :profile {:deleted-at deleted-at} {:id (:id profile)}) + profile)) + +;; --- TESTS + (t/deftest parse-emails (t/is (= ["some@example.com"] (srepl/parse-emails "some@example.com"))) @@ -26,3 +58,95 @@ (t/is (thrown? clojure.lang.ExceptionInfo (srepl/parse-emails 42)))) + +(t/deftest cascade-enqueues-one-delete-object-task-per-deleted-row + (let [deleted (create-deleted-profile! 991 (ct/in-past {:days 30})) + _ (th/create-profile* 992) + submitted (capture-submissions! + #(#'srepl/submit-deleted-cascade + th/*system* {:table "profile" :object :profile}))] + + (t/testing "only the soft-deleted row is processed" + (t/is (= 1 (count submitted)))) + + (t/testing "the enqueued task is a delete-object for that row" + (let [opts (first submitted)] + (t/is (= :delete-object (::wrk/task opts))) + (t/is (= {:object :profile :id (:id deleted)} + (select-keys (::wrk/params opts) [:object :id]))))) + + (t/testing "the date is the row's own, not now" + (t/is (ct/is-before? (:deleted-at (::wrk/params (first submitted))) + (ct/in-past {:days 29})))) + + (t/testing "label is the row id and dedupe is on" + (t/is (= (str (:id deleted)) (::wrk/label (first submitted)))) + (t/is (true? (::wrk/dedupe (first submitted))))))) + +(t/deftest cascade-honours-limit-and-ids + (let [p1 (create-deleted-profile! 993 (ct/in-past {:days 10})) + _ (create-deleted-profile! 994 (ct/in-past {:days 9})) + _ (create-deleted-profile! 995 (ct/in-past {:days 8}))] + + (t/testing "limit bounds how many rows are read" + (let [submitted (capture-submissions! + #(#'srepl/submit-deleted-cascade + th/*system* {:table "profile" :object :profile :limit 2}))] + (t/is (= 2 (count submitted))))) + + (t/testing "ids restricts the run to the given rows" + (let [submitted (capture-submissions! + #(#'srepl/submit-deleted-cascade + th/*system* {:table "profile" :object :profile :ids [(:id p1)]}))] + (t/is (= [{:object :profile :id (:id p1)}] + (mapv #(select-keys % [:object :id]) (params-of submitted)))))))) + +(t/deftest cascade-dry-run-counts-without-enqueueing + (let [_ (create-deleted-profile! 996 (ct/in-past {:days 10})) + submitted (atom []) + result (with-redefs [wrk/submit! (fn [opts] (swap! submitted conj opts))] + (#'srepl/submit-deleted-cascade + th/*system* {:table "profile" :object :profile :dry-run? true}))] + + (t/is (= 1 (:found result))) + (t/is (= 0 (:submitted result))) + (t/is (empty? @submitted)))) + +(t/deftest public-helpers-read-their-own-table + (let [profile (th/create-profile* 997) + team (th/create-team* 997 {:profile-id (:id profile)}) + project (th/create-project* 997 {:profile-id (:id profile) + :team-id (:id team)}) + file (th/create-file* 997 {:profile-id (:id profile) + :project-id (:id project)}) + old (ct/in-past {:days 10})] + + (th/db-update! :profile {:deleted-at old} {:id (:id profile)}) + (th/db-update! :team {:deleted-at old} {:id (:id team)}) + (th/db-update! :project {:deleted-at old} {:id (:id project)}) + (th/db-update! :file {:deleted-at old} {:id (:id file)}) + + (with-redefs [sys/system th/*system*] + (let [ids (fn [submitted] (into #{} (map :id (params-of submitted))))] + + (t/testing "profiles helper" + (let [submitted (capture-submissions! #(srepl/process-deleted-profiles-cascade))] + (t/is (contains? (ids submitted) (:id profile))))) + + (t/testing "teams helper" + (let [submitted (capture-submissions! #(srepl/process-deleted-teams-cascade))] + (t/is (contains? (ids submitted) (:id team))))) + + (t/testing "projects helper" + (let [submitted (capture-submissions! #(srepl/process-deleted-projects-cascade))] + (t/is (contains? (ids submitted) (:id project))))) + + (t/testing "files helper" + (let [submitted (capture-submissions! #(srepl/process-deleted-files-cascade))] + (t/is (contains? (ids submitted) (:id file))))) + + (t/testing "the helpers accept options" + (let [submitted (capture-submissions! + #(srepl/process-deleted-files-cascade :ids [(:id file)]))] + (t/is (= [{:object :file :id (:id file)}] + (mapv #(select-keys % [:object :id]) (params-of submitted)))))))))) diff --git a/backend/test/backend_tests/storage_gc_deleted_test.clj b/backend/test/backend_tests/storage_gc_deleted_test.clj new file mode 100644 index 0000000000..9e1f87f723 --- /dev/null +++ b/backend/test/backend_tests/storage_gc_deleted_test.clj @@ -0,0 +1,93 @@ +;; 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 INC Sucursal en España SL + +(ns backend-tests.storage-gc-deleted-test + (:require + [app.common.time :as ct] + [app.common.uuid :as uuid] + [app.db :as db] + [app.storage :as sto] + [backend-tests.helpers :as th] + [clojure.test :as t])) + +(t/use-fixtures :once th/state-init) +(t/use-fixtures :each th/database-reset) + +;; The GC processes the pending objects in chunks of 25 (see `clean-deleted`), so +;; a chunk boundary is what separates a blocked object from the objects of the +;; next chunk. + +(def ^:private chunk-size 25) + +(defn- put-object! + "Puts a tiny object in storage and returns it." + [deleted-at] + (let [sobject (sto/put-object! (::sto/storage th/*system*) + {::sto/content (sto/content "sobject") + :content-type "text/plain" + :bucket "file-media-object"})] + (th/db-update! :storage-object {:deleted-at deleted-at} {:id (:id sobject)}) + sobject)) + +(defn- blocked-object! + "Puts an object that cannot be deleted because a `file_media_object` points + at it as its thumbnail (a `NO ACTION` foreign key)." + [file-id] + (let [media (sto/put-object! (::sto/storage th/*system*) + {::sto/content (sto/content "media") + :content-type "text/plain" + :bucket "file-media-object"}) + blocked (put-object! (ct/in-past "30m"))] + + (th/db-insert! :file-media-object + {:id (uuid/next) + :file-id file-id + :is-local true + :name "sample" + :media-id (:id media) + :thumbnail-id (:id blocked) + :width 100 + :height 100 + :mtype "image/svg+xml"}) + + blocked)) + +(defn- find-object + [id] + (th/db-get :storage-object {:id id} {::db/remove-deleted false})) + +(t/deftest deletes-the-pending-objects + (let [objects (mapv (fn [_] (put-object! (ct/in-past "10m"))) (range 3)) + result (th/run-task! :storage-gc-deleted {})] + + (t/is (= 3 (:deleted result))) + + (doseq [sobject objects] + (t/is (nil? (find-object (:id sobject))))))) + +(t/deftest blocked-chunk-does-not-stop-the-run + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile)}) + + ;; The blocked object goes first in `deleted_at` order, so it lands in + ;; the first chunk, together with the objects that fill it up. The last + ;; object of the batch lands in the next chunk: it is the one that + ;; proves the run kept going after the failure. + blocked (blocked-object! (:id file)) + _ (mapv (fn [_] (put-object! (ct/in-past "20m"))) (range (dec chunk-size))) + last-id (:id (put-object! (ct/in-past "5m"))) + + result (th/run-task! :storage-gc-deleted {})] + + (t/testing "the run finishes and only the object of the second chunk is deleted" + (t/is (= 1 (:deleted result)))) + + (t/testing "the blocked object is still pending" + (t/is (some? (find-object (:id blocked))))) + + (t/testing "the object of the next chunk is gone" + (t/is (nil? (find-object last-id)))))) diff --git a/docs/technical-guide/configuration.md b/docs/technical-guide/configuration.md index 95412109c9..fdedf463f3 100644 --- a/docs/technical-guide/configuration.md +++ b/docs/technical-guide/configuration.md @@ -622,6 +622,16 @@ In a high-availability (HA) scenario, managing the state outside of replicas is - Valkey: Penpot only needs one Valkey instance to function correctly. Due to the nature of the data it manages, replication isn't even essential. - User media storage: This should not be configured with local storage but rather with centralized storage, such as Kubernetes PVC or S3. +### Draining a backend instance + +To restart one backend without affecting ongoing clients, take it out of the +load balancer first. From the backend REPL, run `(app.srepl.main/set-offline)`. +The `/readyz` endpoint then answers `503 OFFLINE`, so the load balancer stops +sending new requests to that instance while the requests already in flight +finish normally. Wait for the traffic to drop, restart the process, and the +instance comes back online on its own. To undo the drain without a restart, +run `(app.srepl.main/set-online)`. Drain one instance at a time. + ## Backend This section enumerates the backend only configuration variables.