ajet/tbd
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add ui tests to ci
CI / Test + coverage (push) Successful in 1m33s
Details

Browse Source
This commit is contained in:
Adam Jeniski
2026-09-19 19:17:22 -09:00
parent 1926432fc6
commit 47f6cbf2d1
22 changed files with 2426 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.dockerignore
+3 -3
View File
@@ -1,8 +1,8 @@
target
**/target
.cpcache
.git
node_modules
.shadow-cljs
**/node_modules
**/.shadow-cljs
resources/public/js
.env
data
.gitea/workflows/ci.yml
+6 -2
View File
@@ -24,8 +24,12 @@ jobs:
docker compose version
docker buildx version
# Each suite runs once, under Cloverage; the merged report is the dockerized
# equivalent of script/coverage.
# Each suite runs once, under a coverage tool. The Clojure reports (Cloverage) are merged
# below; the UI's (c8) stands on its own. Together this is the dockerized equivalent of
# script/coverage.
- name: UI tests (coverage)
run: script/docker-ui-coverage
- name: Unit tests (coverage)
run: script/docker-unit-coverage
Dockerfile
+13 -1
View File
@@ -2,7 +2,8 @@
# to ../resources/public/js (see ui/shadow-cljs.edn), i.e. /build/resources/public/js here.
# trixie, not bookworm: its default-jre is Java 21, which shadow-cljs's Closure Compiler
# requires (bookworm's is 17 -> UnsupportedClassVersionError).
FROM node:22-trixie-slim AS ui
# ui-base holds what the UI's release build and its tests share: the toolchain and the deps.
FROM node:22-trixie-slim AS ui-base
RUN apt-get update \
&& apt-get install -y --no-install-recommends default-jre-headless \
@@ -14,9 +15,20 @@ RUN npm ci
# Resolve the ClojureScript deps in their own layer so source edits don't re-download them.
COPY ui/shadow-cljs.edn ./
RUN npx shadow-cljs classpath > /dev/null
FROM ui-base AS ui
COPY ui/src ./src
RUN npx shadow-cljs release app
# The UI's tests, not part of the server image: `docker build --target ui-test`
# (script/docker-ui-test, script/docker-ui-coverage). Running the container runs the tests;
# `npm run coverage` (script/docker-ui-coverage) also writes the report to /build/target/coverage/ui.
FROM ui-base AS ui-test
COPY ui/.c8rc.json ./
COPY ui/src ./src
COPY ui/test ./test
CMD ["npm", "test"]
# Stage 2: the server.
# JDK 21+ is required by the MCP server (plumcp runs on virtual threads).
FROM clojure:temurin-21-tools-deps
README.md
+22 -9
View File
@@ -8,7 +8,7 @@ dockerized integration tests, and joint line coverage.
## Requirements
- Docker, for the integration tests and the `script/docker-*` tasks (all CI needs)
- For running tasks natively (optional): [Clojure CLI](https://clojure.org/guides/install_clojure) (tools.deps) with JDK 21+, [Node](https://nodejs.org/) 20+ (with a JDK) for the UI build, and [Babashka](https://babashka.org/) for `script/coverage-report`
- For running tasks natively (optional): [Clojure CLI](https://clojure.org/guides/install_clojure) (tools.deps) with JDK 21+, [Node](https://nodejs.org/) 20+ (22.22+ for the UI tests; with a JDK) for the UI build, and [Babashka](https://babashka.org/) for `script/coverage-report`
## Running
@@ -224,7 +224,8 @@ directory at `/js`, and serves `resources/public/index.html`, the shell that mou
| `script/ui-build` | Optimized release build into `resources/public/js` |
| `script/ui-watch` | Rebuilds on every change, with hot reload; run `script/server` alongside and refresh the page |
The Docker image builds the UI in its own stage, so `docker build` needs no local Node.
The Docker image builds the UI in its own stage, so `docker build` needs no local Node. The UI's tests run
in another stage of the same Dockerfile (`--target ui-test`), which the server image doesn't include.
### Browser MCP tools (WebMCP)
@@ -271,23 +272,35 @@ script/repl
| Task | What it does |
|------|--------------|
| `script/unit-test` | Runs the Clojure tests in `test/` |
| `script/ui-test` | Runs the ClojureScript tests in `ui/test/` under Node (needs Node and a JDK; CI doesn't run it yet) |
| `script/ui-test` | Runs the ClojureScript tests in `ui/test/` under Node, in a [jsdom](https://github.com/jsdom/jsdom) window (needs Node and a JDK) |
| `script/integration-test` | Builds the app image, starts it on a random port, runs the [integration suite](integration-test/README.md) against it, then tears it down |
| `script/test` | Unit tests, then integration tests (stops at the first failure) |
| `script/test` | UI tests, unit tests, then integration tests (stops at the first failure) |
| `script/docker-unit-test` | Same as `script/unit-test`, but inside the app image (Docker only) |
| `script/docker-ui-test` | Same as `script/ui-test`, but inside a Node + JDK image (Docker only) |
The UI tests render the real app in jsdom against a fake server and drive it like a user (type, submit,
click), next to plain tests of the re-frame events and subscriptions, the game rules and the WebMCP tools
(`ui/test/tbd/ui/`; the shared fakes are in `test_util.cljs`). `ui/test/dom-setup.cjs` gives them a
`window` and the real WebMCP library, and fails a run that hangs, rejects a promise nobody handles, or ends
without a result (a test that never calls `done` would otherwise pass or stall silently). `npm test` in
`ui/` preloads it, so use that (or the scripts) rather than running the build's output directly.
### Coverage
Line coverage via [Cloverage](https://github.com/cloverage/cloverage):
Line coverage of the Clojure code via [Cloverage](https://github.com/cloverage/cloverage), and of the UI via
[c8](https://github.com/bcoe/c8):
| Task | Output |
|------|--------|
| `script/unit-coverage` | `target/coverage/unit/` |
| `script/integration-coverage` | `target/coverage/integration/` |
| `script/coverage` | Runs both, then writes the merged report to `target/coverage/merged/` |
| `script/docker-unit-coverage`, `script/docker-coverage-report` | Dockerized versions of the unit run and the merge step, so `script/docker-unit-coverage`, `script/integration-coverage`, `script/docker-coverage-report` is `script/coverage` with no local Clojure or Babashka (this is what CI runs) |
| `script/ui-coverage` | `target/coverage/ui/` (V8 coverage of the compiled UI, mapped back to `ui/src/**/*.cljs` through the source maps) |
| `script/coverage` | Runs all three, then writes the merged Clojure report to `target/coverage/merged/` (the UI's stays separate) |
| `script/docker-unit-coverage`, `script/docker-ui-coverage`, `script/docker-coverage-report` | Dockerized versions of the unit run, the UI run and the merge step, so `script/docker-ui-coverage`, `script/docker-unit-coverage`, `script/integration-coverage`, `script/docker-coverage-report` is `script/coverage` with no local Clojure, Node or Babashka (this is what CI runs) |
Each report directory has an `index.html` and an `lcov.info`. See
Each report directory has an `index.html` and an `lcov.info`. The UI's numbers are approximate where one
ClojureScript form compiles to several JavaScript blocks (a `case` or `cond`, say): a line can show as
uncovered when only part of the form ran. See
[integration-test/README.md](integration-test/README.md) for how integration coverage is
collected.
@@ -310,7 +323,7 @@ ui/ ClojureScript re-frame app (shadow-cljs project); ui/src/t
resources/public/ index.html (the shell served at /) and js/ (compiled UI output, git-ignored)
test/ Unit tests
integration-test/ Dockerized integration tests and coverage harness
script/ Bash entry points (server, ui-build, test, coverage, repl, ...) and coverage helpers
script/ Bash entry points (server, ui-build, ui-test, test, coverage, repl, ...) and coverage helpers
```
To add a new group, create `tbd.<group>.routes` with a `routes` fn that returns a reitit route
script/coverage
+3 -2
View File
@@ -1,9 +1,10 @@
#!/usr/bin/env bash
# Run the full suite (unit + integration) with line coverage and write the joint
# report to target/coverage/merged.
# Run the full suite (UI + unit + integration) with line coverage. The Clojure suites'
# joint report goes to target/coverage/merged; the UI's is separate (target/coverage/ui).
set -euo pipefail
cd "$(dirname "$0")/.."
script/ui-coverage
script/unit-coverage
script/integration-coverage
script/coverage-report
script/docker-ui-coverage
Executable
+20
View File
@@ -0,0 +1,20 @@
#!/usr/bin/env bash
# Run the UI's tests under c8 inside a Node + JDK image; needs only Docker. The report is
# copied out with `docker cp` (not a bind mount) so it works when this itself runs in a
# job container. Output: target/coverage/ui.
set -euo pipefail
cd "$(dirname "$0")/.."
source script/lib/docker.sh
build_ui_test_image
id=$(docker create --security-opt apparmor=unconfined tbd-ui-test npm run coverage)
trap 'docker rm -f "$id" >/dev/null' EXIT
status=0
docker start -a "$id" || status=$?
rm -rf target/coverage/ui
mkdir -p target/coverage
docker cp "$id:/build/target/coverage/ui" target/coverage/ || echo "[test] WARNING: no UI coverage report was produced"
exit "$status"
script/docker-ui-test
Executable
+8
View File
@@ -0,0 +1,8 @@
#!/usr/bin/env bash
# Run the UI's (ClojureScript) tests inside a Node + JDK image; needs only Docker.
set -euo pipefail
cd "$(dirname "$0")/.."
source script/lib/docker.sh
build_ui_test_image
exec docker run --rm --security-opt apparmor=unconfined tbd-ui-test
script/lib/docker.sh
+6
View File
@@ -18,3 +18,9 @@ build_unit_image() {
use_builder
docker buildx build --load --build-arg DEPS_ALIASES=test:cov -t tbd-unit .
}
# Builds the UI's test image (Node + JDK, the UI's deps, sources and tests), tagged tbd-ui-test.
build_ui_test_image() {
use_builder
docker buildx build --load --target ui-test -t tbd-ui-test .
}
script/test
+2 -1
View File
@@ -1,7 +1,8 @@
#!/usr/bin/env bash
# Run the unit tests, then the integration tests (stops at the first failure).
# Run the UI tests, the unit tests, then the integration tests (stops at the first failure).
set -euo pipefail
cd "$(dirname "$0")/.."
script/ui-test
script/unit-test
script/integration-test
script/ui-coverage
Executable
+8
View File
@@ -0,0 +1,8 @@
#!/usr/bin/env bash
# Run the UI's tests with line coverage (c8, mapped back to the ClojureScript); the report goes
# to target/coverage/ui. Needs Node and a JDK, like script/ui-test.
set -euo pipefail
cd "$(dirname "$0")/../ui"
[[ -d node_modules ]] || npm ci
exec npm run coverage
script/ui-test
+3 -2
View File
@@ -1,7 +1,8 @@
#!/usr/bin/env bash
# Run the UI's (ClojureScript) tests under Node. Needs Node and a JDK, like script/ui-build.
# Run the UI's (ClojureScript) tests under Node, in a jsdom window. Needs Node and a JDK, like
# script/ui-build. script/docker-ui-test does the same with only Docker.
set -euo pipefail
cd "$(dirname "$0")/../ui"
[[ -d node_modules ]] || npm ci
exec npx shadow-cljs compile test
exec npm test
ui/.c8rc.json
+7
View File
@@ -0,0 +1,7 @@
{
"temp-directory": "target/c8",
"reports-dir": "../target/coverage/ui",
"reporter": ["text", "html", "lcovonly"],
"include": [".shadow-cljs/builds/test/dev/out/cljs-runtime/tbd.ui.*.js"],
"exclude": ["**/node_modules/**", "**/*_test.js", "**/tbd.ui.test_util.js"]
}
ui/package-lock.json
Generated
+1165
View File
File diff suppressed because it is too large Load Diff
ui/package.json
+5 -1
View File
@@ -5,7 +5,9 @@
"description": "ClojureScript (re-frame) front end for the tbd server",
"scripts": {
"watch": "shadow-cljs watch app",
"release": "shadow-cljs release app"
"release": "shadow-cljs release app",
"test": "shadow-cljs compile test && node -r ./test/dom-setup.cjs target/ui-test/test.js",
"coverage": "shadow-cljs compile test && c8 --reporter=none node -r ./test/dom-setup.cjs target/ui-test/test.js && cp -r src/tbd .shadow-cljs/builds/test/dev/out/cljs-runtime/ && c8 report"
},
"dependencies": {
"@jason.today/webmcp": "0.1.13",
@@ -13,6 +15,8 @@
"react-dom": "^19.3.0"
},
"devDependencies": {
"c8": "^12.0.0",
"jsdom": "^30.1.0",
"shadow-cljs": "^3.5.3"
}
}
ui/shadow-cljs.edn
+4 -3
View File
@@ -13,8 +13,9 @@
:modules {:main {:init-fn tbd.ui.core/init}}
:devtools {:after-load tbd.ui.core/reload}}
;; script/ui-test: the tests run under Node, against fakes of fetch and navigator.modelContext.
;; script/ui-test (npm test): the tests run under Node, in a jsdom window (test/dom-setup.cjs,
;; which npm test preloads), against a fake server (fetch). Not :autorun: the preload has to
;; come first, so npm test starts node itself.
:test {:target :node-test
:output-to "target/ui-test/test.js"
:ns-regexp "-test$"
:autorun true}}}
:ns-regexp "-test$"}}}
ui/test/dom-setup.cjs
+66
View File
@@ -0,0 +1,66 @@
// Preloaded by `npm test` (node -r) before any compiled code runs: gives the ClojureScript
// tests a browser-like global scope (window, document, location, ...) backed by jsdom.
//
// It has to happen first: React DOM decides at load time whether the browser supports the
// `input` event; without a `window` then, <input onChange> never fires under test.
const { JSDOM } = require("jsdom");
const { window } = new JSDOM('<!doctype html><html><body><div id="app"></div></body></html>', {
url: "http://localhost:3000/",
});
// Copy the window's globals over, but leave Node's own (fetch, setTimeout, navigator, ...) alone.
for (const key of Object.getOwnPropertyNames(window)) {
if (!(key in globalThis)) {
Object.defineProperty(globalThis, key, {
configurable: true,
get: () => window[key],
set: (value) => Object.defineProperty(globalThis, key, { value, writable: true, configurable: true }),
});
}
}
globalThis.window = window;
// WebMCP, for `require("@jason.today/webmcp/src/webmcp.js")`. Its only export is
// `module.exports = WebMCP`, guarded by `typeof module`, in a file its package.json declares as an
// ES module. The browser build wraps it as CommonJS, so there it exports the class; Node's
// require() loads it as ESM, where `module` doesn't exist, and gets nothing. So run the same
// source with a `module` to export to, and hand that to require.
const Module = require("module");
const fs = require("fs");
const webmcp = require.resolve("@jason.today/webmcp/src/webmcp.js");
const cjs = new Module(webmcp);
cjs.filename = webmcp;
new Function("module", "exports", fs.readFileSync(webmcp, "utf8"))(cjs, cjs.exports);
cjs.loaded = true;
require.cache[webmcp] = cjs;
// A run that doesn't finish must not look like a pass. An async test that throws before it calls
// `done` (or whose promise chain rejects) never ends: the process then hangs, or runs out of things
// to do and exits 0 without a word. Fail instead, and say which test it was.
function fail(message) {
console.error(`\nFAILED: ${message}`);
process.exit(1);
}
process.on("unhandledRejection", (reason) =>
fail(`unhandled promise rejection (an async test without a catch?): ${(reason && reason.stack) || reason}`));
// tbd.ui.test-util keeps `uiTestsCurrent` up to date: the test that is running, and since when.
const STUCK_MS = 30000;
globalThis.uiTestsCurrent = { name: "loading the tests", since: Date.now() };
setInterval(() => {
const { name, since } = globalThis.uiTestsCurrent;
if (Date.now() - since > STUCK_MS) {
fail(`stuck for ${STUCK_MS / 1000}s in ${name} (an async test that never called done?)`);
}
}, 1000).unref();
// ... and sets `uiTestsFinished` once cljs.test has printed its summary.
process.on("exit", (code) => {
if (code === 0 && !globalThis.uiTestsFinished) {
console.error("\nFAILED: the tests ended without reporting a result");
process.exitCode = 1;
}
});
ui/test/tbd/ui/core_test.cljs
+68
View File
@@ -0,0 +1,68 @@
(ns tbd.ui.core-test
(:require [cljs.test :refer [deftest is async use-fixtures]]
[re-frame.db :as rf-db]
[reagent.dom.client :as rdc]
[tbd.ui.core :as core]
[tbd.ui.test-util :as tu]
[tbd.ui.webmcp :as webmcp]))
;; init runs as in the browser, WebMCP widget included (the library is loaded through
;; test/webmcp-shim.cjs; see shadow-cljs.edn). Each test gets a fresh widget, and it is taken
;; off the page afterwards.
(defn- widget [] @@#'webmcp/widget)
(defn- tools-in-widget
"The names of the tools the WebMCP widget offers its client."
[]
(set (js/Array.from (.keys (.-availableTools ^js (widget))))))
(def ^:private real-log (.-log js/console))
(use-fixtures :each
tu/fake-server-fixture
{:before (fn []
(reset! @#'webmcp/widget nil)
;; The widget logs every tool it registers. (Not console.log as a whole: that is
;; where the test report goes.)
(set! (.-log js/console)
(fn [& args]
(when-not (re-find #"^(Tool registered|Saved items)" (str (first args)))
(.apply real-log js/console (to-array args))))))
:after (fn []
(set! (.-log js/console) real-log)
(when-let [w (widget)]
(some-> (.getElementById js/document (.-elementId ^js w)) .remove))
(reset! @#'webmcp/widget nil)
(.clear js/sessionStorage)
;; init mounts the page in a root of its own.
(when-let [root @core/root]
(rdc/unmount root)
(reset! core/root nil)))})
(deftest init-test
(tu/log-in!)
(async done
(tu/finish
(tu/steps
(fn []
(core/init)
(is (= :unknown (get-in @rf-db/app-db [:user :status])) "it starts out not knowing who is logged in")
(tu/shows "the page is on the screen" "main h1" "tbd"))
(fn []
(is (some? (.getElementById js/document (.-elementId ^js (widget)))) "the WebMCP widget is on the page")
(is (= (set (map :name webmcp/tools)) (tools-in-widget)) "it offers the page's tools to the agent")
;; A tool, as the agent's client calls it.
(let [ping (.-execute (.get (.-availableTools ^js (widget)) "ping"))]
(-> (ping #js {})
(.then (fn [result] (is (= "pong" (.. result -content (at 0) -text))))))))
(fn []
(tu/shows "it found out who is logged in, and shows the todos" "section h2" "Todos"))
(fn []
(is (= :logged-in (get-in @rf-db/app-db [:user :status])))
;; The hot-reload hook redraws and registers the tools again, without starting over.
(.clear (.-availableTools ^js (widget)))
(core/reload)
(is (= (set (map :name webmcp/tools)) (tools-in-widget)))
(tu/shows "still there after a reload" "main h1" "tbd")))
done)))
ui/test/tbd/ui/events_test.cljs
+323
View File
@@ -0,0 +1,323 @@
(ns tbd.ui.events-test
(:require [cljs.test :refer [deftest is testing async use-fixtures]]
[re-frame.core :as rf]
[re-frame.db :as rf-db]
[tbd.ui.db :as db]
[tbd.ui.events :as events]
[tbd.ui.test-util :as tu]))
;; The handlers run for real; what they ask the outside world for (a request, the clipboard, a
;; timer) is recorded in `effects` instead of happening, and the test plays the answer. Events
;; they set off with :dispatch wait in `queued` until `dispatch!` runs them (re-frame itself
;; would run them a moment later, and refuses dispatch-sync from inside a handler).
(def ^:private effects (atom []))
(def ^:private queued (atom []))
(defn- record [id]
(fn [value] (swap! effects conj [id value])))
(use-fixtures :each
{:before (fn [] (reset! effects []) (reset! queued []))}
(tu/stub-effects-fixture {::events/fetch (record ::events/fetch)
::events/copy-to-clipboard (record ::events/copy-to-clipboard)
:dispatch-later (record :dispatch-later)
:dispatch #(swap! queued conj %)}))
(defn- dispatch!
"Dispatches `event` and, one after the other, the events it sets off."
[event]
(rf/dispatch-sync event)
(while (seq @queued)
(let [[next-event] @queued]
(swap! queued subvec 1)
(rf/dispatch-sync next-event))))
(defn- app-db [] @rf-db/app-db)
(defn- requests
"The requests asked for so far, as {:uri :method :body :on-response}."
[]
(mapv second (filter (comp #{::events/fetch} first) @effects)))
(defn- last-request [] (last (requests)))
(defn- answer!
"The server answers the last request."
([status body] (answer! (last-request) status body))
([request status body]
(dispatch! (conj (:on-response request)
{:ok? (< status 300) :status status :body (if (string? body) body (pr-str body))}))))
(defn- start!
"The page is starting: the db is initialized, and it is asking who is logged in (the only
request so far)."
[]
(reset! effects [])
(dispatch! [::events/initialize]))
(def ^:private todo-1 {:id 1 :owner-id 7 :title "buy milk" :done false :created-at 1 :updated-at 1})
(def ^:private todo-2 {:id 2 :owner-id 7 :title "walk dog" :done false :created-at 2 :updated-at 2})
(defn- logged-in!
"The page is up, alice is logged in and her todos (`items`) are shown."
[items]
(start!)
(answer! 200 {:login "alice" :id 7})
(answer! 200 {:todos items})
(reset! effects []))
;; --- Starting up ---
(deftest initialize-test
(dispatch! [::events/initialize])
(is (= db/default-db (app-db)))
(testing "it asks who is logged in"
(is (= [{:uri "/auth/me" :on-response [::events/user-response]}] (requests)))))
;; --- Calculator ---
(deftest set-operand-test
(start!)
(dispatch! [::events/set-operand :x "1.5"])
(dispatch! [::events/set-operand :y "-2"])
(is (= {:x "1.5" :y "-2"} (select-keys (:calc (app-db)) [:x :y]))))
(deftest add-test
(start!)
(dispatch! [::events/set-operand :x "1.5"])
(dispatch! [::events/set-operand :y "-2"])
(dispatch! [::events/add])
(testing "it asks the server, and shows that it is waiting"
(is (= "/api/add?x=1.5&y=-2" (:uri (last-request))))
(is (nil? (:method (last-request))) "a GET")
(is (= {:status :loading} (get-in (app-db) [:calc :result]))))
(testing "the sum comes back"
(answer! 200 {:result -0.5})
(is (= {:status :ok :x "1.5" :y "-2" :sum -0.5} (get-in (app-db) [:calc :result])))))
(deftest add-encodes-the-operands-test
(start!)
(dispatch! [::events/set-operand :x "1&y=9"])
(dispatch! [::events/set-operand :y "a b"])
(dispatch! [::events/add])
(is (= "/api/add?x=1%26y%3D9&y=a%20b" (:uri (last-request)))))
(deftest add-error-test
(start!)
(testing "the server's message and the fields it objects to"
(dispatch! [::events/add])
(answer! 400 {:error "Invalid parameters" :details {:x ["must be a number"] :y ["must be a number"]}})
(is (= {:status :error :message "Invalid parameters (x, y)"} (get-in (app-db) [:calc :result]))))
(testing "a message without details"
(dispatch! [::events/add])
(answer! 500 {:error "Boom"})
(is (= "Boom" (get-in (app-db) [:calc :result :message]))))
(testing "an answer that isn't EDN falls back to the status"
(dispatch! [::events/add])
(answer! 502 "<html>Bad gateway</html>")
(is (= "HTTP 502" (get-in (app-db) [:calc :result :message]))))
(testing "so does one that can't be read at all"
(dispatch! [::events/add])
(answer! 500 "{:error")
(is (= "HTTP 500" (get-in (app-db) [:calc :result :message]))))
(testing "an empty answer too"
(dispatch! [::events/add])
(answer! 500 "")
(is (= "HTTP 500" (get-in (app-db) [:calc :result :message]))))
(testing "no answer at all shows what went wrong"
(dispatch! [::events/add])
(dispatch! (conj (:on-response (last-request)) {:ok? false :status nil :body "Failed to fetch"}))
(is (= "Failed to fetch" (get-in (app-db) [:calc :result :message])))))
;; --- Login ---
(deftest user-response-test
(testing "logged in: remembers who, and loads the todos"
(start!)
(answer! 200 {:login "alice" :id 7})
(is (= {:status :logged-in :login "alice"} (:user (app-db))))
(is (= "/api/todos" (:uri (last-request)))))
(testing "401 only means nobody is logged in"
(start!)
(answer! 401 {:error "not logged in"})
(is (= {:status :anonymous} (:user (app-db))))
(is (= 1 (count (requests))) "so no todos are asked for"))
(testing "anything else is a failure"
(start!)
(answer! 500 {:error "Boom"})
(is (= {:status :error :message "Boom"} (:user (app-db))))))
(deftest logout-test
(logged-in! [todo-1])
(dispatch! [::events/logout])
(is (= {:uri "/auth/logout" :method "POST" :on-response [::events/logout-response]} (last-request)))
(testing "the page forgets the user and their todos"
(answer! 200 {:logged-out true})
(is (= {:status :anonymous} (:user (app-db))))
(is (= (:todos db/default-db) (:todos (app-db))))))
(deftest logout-failure-test
(logged-in! [todo-1])
(dispatch! [::events/logout])
(answer! 500 {:error "Boom"})
(is (= :logged-in (get-in (app-db) [:user :status])) "still logged in")
(is (= [todo-1] (get-in (app-db) [:todos :items])))
(is (= "Boom" (get-in (app-db) [:todos :error]))))
;; --- Todos ---
(deftest load-todos-test
(start!)
(answer! 200 {:login "alice" :id 7})
(is (= :loading (get-in (app-db) [:todos :status])))
(testing "the list arrives"
(answer! 200 {:todos [todo-1 todo-2]})
(is (= :ok (get-in (app-db) [:todos :status])))
(is (= [todo-1 todo-2] (get-in (app-db) [:todos :items]))))
(testing "a failed load shows the message, and the next one clears it"
(dispatch! [::events/load-todos])
(answer! 500 {:error "Boom"})
(is (= {:status :error :error "Boom"} (select-keys (:todos (app-db)) [:status :error])))
(dispatch! [::events/load-todos])
(is (nil? (get-in (app-db) [:todos :error])))))
(deftest add-todo-test
(logged-in! [todo-1])
(dispatch! [::events/set-new-title "walk dog"])
(is (= "walk dog" (get-in (app-db) [:todos :new-title])))
(dispatch! [::events/add-todo])
(is (= {:uri "/api/todos" :method "POST" :body {:title "walk dog"} :on-response [::events/todo-added]}
(last-request)))
(testing "the new todo joins the list and the field is emptied"
(answer! 201 todo-2)
(is (= [todo-1 todo-2] (get-in (app-db) [:todos :items])))
(is (= "" (get-in (app-db) [:todos :new-title])))))
(deftest add-todo-failure-test
(logged-in! [todo-1])
(dispatch! [::events/set-new-title " "])
(dispatch! [::events/add-todo])
(answer! 400 {:error "Invalid body" :details {:title ["must not be blank"]}})
(testing "the message shows, and the list and what was typed stay as they are"
(is (= "Invalid body (title)" (get-in (app-db) [:todos :error])))
(is (= [todo-1] (get-in (app-db) [:todos :items])))
(is (= " " (get-in (app-db) [:todos :new-title]))))
(testing "the next request clears the message"
(dispatch! [::events/add-todo])
(is (nil? (get-in (app-db) [:todos :error])))))
(deftest set-done-test
(logged-in! [todo-1 todo-2])
(dispatch! [::events/set-done 2 true])
(is (= {:uri "/api/todos/2" :method "PATCH" :body {:done true} :on-response [::events/todo-changed]}
(last-request)))
(testing "the todo is replaced by what the server made of it, in place"
(answer! 200 (assoc todo-2 :done true :updated-at 5))
(is (= [todo-1 (assoc todo-2 :done true :updated-at 5)] (get-in (app-db) [:todos :items]))))
(testing "a failure keeps the list and shows why"
(dispatch! [::events/set-done 1 true])
(answer! 404 {:error "todo not found"})
(is (= "todo not found" (get-in (app-db) [:todos :error])))
(is (false? (:done (first (get-in (app-db) [:todos :items])))))))
(deftest delete-todo-test
(logged-in! [todo-1 todo-2])
(dispatch! [::events/delete-todo 1])
(is (= {:uri "/api/todos/1" :method "DELETE" :on-response [::events/todo-deleted 1]} (last-request)))
(testing "it goes from the list"
(answer! 200 {:deleted true})
(is (= [todo-2] (get-in (app-db) [:todos :items]))))
(testing "a failure keeps the list and shows why"
(dispatch! [::events/delete-todo 2])
(answer! 500 {:error "Boom"})
(is (= [todo-2] (get-in (app-db) [:todos :items])))
(is (= "Boom" (get-in (app-db) [:todos :error])))))
(deftest expired-session-test
(testing "a 401 to any change falls back to the logged-out view"
(doseq [[event] [[[::events/add-todo]]
[[::events/set-done 1 true]]
[[::events/delete-todo 1]]]]
(logged-in! [todo-1])
(dispatch! event)
(answer! 401 {:error "not logged in"})
(is (= {:status :anonymous} (:user (app-db))) (str event))
(is (= (:todos db/default-db) (:todos (app-db))) "the todos are hidden and forgotten"))))
;; --- MCP setup ---
(deftest copy-mcp-command-test
(start!)
(reset! effects [])
(dispatch! [::events/copy-mcp-command "claude mcp add ..."])
(is (true? (get-in (app-db) [:mcp :copied?])))
(testing "it asks for the command to be copied, and for the button to go back after a moment"
(is (= [[::events/copy-to-clipboard "claude mcp add ..."]
[:dispatch-later [{:ms 2000 :dispatch [::events/mcp-copied-timeout]}]]]
@effects)))
(dispatch! [::events/mcp-copied-timeout])
(is (false? (get-in (app-db) [:mcp :copied?]))))
;; --- The effects themselves ---
(defn- with-clipboard
"Runs `f` with navigator.clipboard set to `clipboard` (or absent, when nil)."
[clipboard f]
(js/Object.defineProperty js/navigator "clipboard" #js {:value clipboard :configurable true})
(try (f) (finally (js-delete js/navigator "clipboard"))))
(deftest copy-to-clipboard-effect-test
(let [copy (tu/real-effect ::events/copy-to-clipboard)
written (atom [])]
(testing "it writes to the clipboard"
(with-clipboard #js {:writeText #(do (swap! written conj %) (js/Promise.resolve))}
#(copy "hello"))
(is (= ["hello"] @written)))
(testing "a clipboard that refuses is ignored"
(with-clipboard #js {:writeText (fn [_] (js/Promise.reject (js/Error. "denied")))}
#(copy "hello")))
(testing "no clipboard, no error"
(with-clipboard nil #(copy "hello")))))
(deftest fetch-effect-test
;; The real effect, against a fake `fetch`; the answer is dispatched to ::answered.
(let [fetch-fx (tu/real-effect ::events/fetch)
calls (atom [])
answer (atom nil)
real-fetch (.-fetch js/globalThis)]
(rf/reg-event-fx ::answered (fn [_ [_ resp]] (@answer resp) {}))
(let [ask (fn [request reply]
(js/Promise. (fn [resolve]
(reset! answer #(resolve %))
(aset js/globalThis "fetch" reply)
(fetch-fx (assoc request :on-response [::answered])))))]
(async done
(-> (tu/steps
#(ask {:uri "/api/ping"}
(fn [uri opts]
(swap! calls conj [uri (js->clj opts)])
(js/Promise.resolve #js {:ok true :status 200 :text (fn [] (js/Promise.resolve "pong"))})))
(fn [resp]
(testing "a plain GET"
(is (= [["/api/ping" {"method" "GET"}]] @calls))
(is (= {:ok? true :status 200 :body "pong"} resp)))
(reset! calls [])
(ask {:uri "/api/todos" :method "POST" :body {:title "x"}}
(fn [uri opts]
(swap! calls conj [uri (js->clj opts)])
(js/Promise.resolve #js {:ok false :status 400 :text (fn [] (js/Promise.resolve "bad"))}))))
(fn [resp]
(testing "a body is sent as EDN"
(is (= [["/api/todos" {"method" "POST"
"headers" {"Content-Type" "application/edn"}
"body" "{:title \"x\"}"}]]
@calls)))
(testing "a failure status is passed on, with the body"
(is (= {:ok? false :status 400 :body "bad"} resp)))
(ask {:uri "/api/ping"} (fn [_ _] (js/Promise.reject (js/Error. "Failed to fetch")))))
(fn [resp]
(testing "a network failure has no status, and says what went wrong"
(is (= {:ok? false :status nil :body "Failed to fetch"} resp)))))
(.finally #(aset js/globalThis "fetch" real-fetch))
(tu/finish done))))))
ui/test/tbd/ui/subs_test.cljs
+55
View File
@@ -0,0 +1,55 @@
(ns tbd.ui.subs-test
(:require [cljs.test :refer [deftest is testing use-fixtures]]
[re-frame.core :as rf]
[re-frame.db :as rf-db]
[re-frame.subs :as rf-subs]
[tbd.ui.db :as db]
[tbd.ui.subs :as subs]
[tbd.ui.tictactoe :as ttt]))
(use-fixtures :each
{:before #(do (rf/clear-subscription-cache!)
(reset! rf-db/app-db db/default-db))})
(defn- sub
"The value of a subscription. (Read outside of a component, which re-frame warns about.)"
[query]
(with-redefs [rf-subs/warn-when-not-reactive (fn [])]
@(rf/subscribe query)))
(defn- db! [f & args]
(apply swap! rf-db/app-db f args))
(deftest plain-subs-test
(testing "a new page"
(is (= "" (sub [::subs/operand :x])))
(is (= {:status :idle} (sub [::subs/result])))
(is (= {:status :unknown} (sub [::subs/user])))
(is (= (:todos db/default-db) (sub [::subs/todos])))
(is (false? (sub [::subs/mcp-copied?]))))
(testing "they follow the db"
(db! assoc-in [:calc :x] "4")
(db! assoc-in [:calc :result] {:status :ok :x "4" :y "1" :sum 5})
(db! assoc :user {:status :logged-in :login "alice"})
(db! assoc-in [:todos :items] [{:id 1 :title "a"}])
(db! assoc-in [:mcp :copied?] true)
(is (= "4" (sub [::subs/operand :x])))
(is (= 5 (:sum (sub [::subs/result]))))
(is (= "alice" (:login (sub [::subs/user]))))
(is (= [{:id 1 :title "a"}] (:items (sub [::subs/todos]))))
(is (true? (sub [::subs/mcp-copied?])))))
(deftest ttt-game-test
(let [set-board! (fn [cells turn] (db! assoc :ttt {:board (mapv {\x :x \o :o} cells) :turn turn}))]
(testing "a new game: X to move, nobody has won"
(is (= {:board ttt/new-board :turn :x :outcome nil} (sub [::subs/ttt-game]))))
(testing "in progress"
(set-board! "x...o...." :x)
(is (= {:board [:x nil nil nil :o nil nil nil nil] :turn :x :outcome nil}
(sub [::subs/ttt-game]))))
(testing "a win, with the line"
(set-board! "xxxoo...." :o)
(is (= {:player :x :line [0 1 2]} (:outcome (sub [::subs/ttt-game])))))
(testing "a draw"
(set-board! "xoxxoooxx" :o)
(is (= :draw (:outcome (sub [::subs/ttt-game])))))))
ui/test/tbd/ui/test_util.cljs
+220
View File
@@ -0,0 +1,220 @@
(ns tbd.ui.test-util
"Shared fakes for the UI tests: the server the page talks to (a stand-in for `fetch`), a way
to stub re-frame effects, and helpers to drive the page in jsdom (see dom-setup.cjs)."
(:require [cljs.reader :as reader]
[cljs.test :as t :refer [is]]
[re-frame.registrar :as registrar]
[reagent.dom.client :as rdc]))
;; --- Telling dom-setup.cjs how the run is going (it fails a run that gets stuck or ends early) ---
(let [begin (get-method t/report [::t/default :begin-test-var])]
(defmethod t/report [::t/default :begin-test-var] [m]
(when begin (begin m))
(set! (.-uiTestsCurrent js/globalThis)
#js {:name (str (:name (meta (:var m)))) :since (js/Date.now)})))
(let [summary (get-method t/report [::t/default :summary])]
(defmethod t/report [::t/default :summary] [m]
(summary m)
(set! (.-uiTestsFinished js/globalThis) true)))
;; --- A fake server ---
(def server
"What the fake server holds: {:user nil-or-{:login ..}, :todos [..], :next-id n, :add-error msg}."
(atom nil))
(defn- respond [status body]
{:status status :body (pr-str body)})
(defn- route [method uri body]
(let [{:keys [user todos]} @server
todo-id (some->> (re-find #"^/api/todos/(\d+)$" uri) second js/parseInt)]
(cond
(= "/auth/me" uri) (if user (respond 200 user) (respond 401 {:error "not logged in"}))
(and (= "POST" method) (= "/auth/logout" uri)) (do (swap! server assoc :user nil)
(respond 200 {:logged-out true}))
(and (= "GET" method) (re-find #"^/api/add\?" uri))
(let [[_ x y] (re-find #"x=([^&]*)&y=([^&]*)" uri)]
(if-let [error (:add-error @server)]
(respond 400 {:error error :details {:x ["is wrong"]}})
(respond 200 {:result (+ (js/parseFloat x) (js/parseFloat y))})))
(not user) (respond 401 {:error "not logged in"})
(and (= "GET" method) (= "/api/todos" uri)) (respond 200 {:todos todos})
(and (= "POST" method) (= "/api/todos" uri))
(if (seq (.trim (:title body)))
(let [todo {:id (:next-id @server) :owner-id 7 :title (:title body) :done false
:created-at 1 :updated-at 1}]
(swap! server #(-> % (update :todos conj todo) (update :next-id inc)))
(respond 201 todo))
(respond 400 {:error "Invalid body" :details {:title ["must not be blank"]}}))
(and (= "PATCH" method) todo-id)
(if-let [todo (first (filter #(= todo-id (:id %)) todos))]
(let [changed (merge todo body)]
(swap! server update :todos (fn [ts] (mapv #(if (= todo-id (:id %)) changed %) ts)))
(respond 200 changed))
(respond 404 {:error "todo not found"}))
(and (= "DELETE" method) todo-id)
(do (swap! server update :todos (fn [ts] (filterv #(not= todo-id (:id %)) ts)))
(respond 200 {:deleted true}))
:else (respond 404 {:error "not found"}))))
(defn fake-fetch [uri opts]
(let [opts (js->clj opts :keywordize-keys true)
{:keys [status body]} (route (:method opts) uri (some-> (:body opts) reader/read-string))]
(js/Promise.resolve
#js {:ok (< status 300) :status status :text (fn [] (js/Promise.resolve body))})))
(def ^:private real-fetch (.-fetch js/globalThis))
(def fake-server-fixture
"Each test starts with an empty server, nobody logged in, and `fetch` talking to it."
{:before (fn []
(reset! server {:user nil :todos [] :next-id 1})
(aset js/globalThis "fetch" fake-fetch))
:after (fn []
(aset js/globalThis "fetch" real-fetch))})
(defn log-in! [] (swap! server assoc :user {:login "alice" :id 7}))
;; --- Stubbing re-frame effects ---
(defn- set-effect!
"Installs `handler` for effect `id`. (Not reg-fx: that warns about every overwrite.)"
[id handler]
(swap! registrar/kind->id->handler assoc-in [:fx id] handler))
(def ^:private real-effects
"The effect handlers as the app registered them, before any test stubbed one."
(atom {}))
(defn real-effect
"The app's own handler for effect `id`, even while a test has it stubbed."
[id]
(or (get @real-effects id)
(let [handler (registrar/get-handler :fx id)]
(swap! real-effects assoc id handler)
handler)))
(defn stub-effects-fixture
"A fixture that replaces re-frame effects for the length of a test. `stubs` is a map of effect
id to a function of the effect's value, which is called instead of the real handler."
[stubs]
{:before (fn []
(doseq [[id handler] stubs]
(real-effect id)
(set-effect! id handler)))
:after (fn []
(doseq [id (keys stubs)]
(set-effect! id (real-effect id))))})
;; --- Driving the page ---
(defn- poll
"A promise of {:ok? bool :value v}: `(f)` as soon as it is truthy, or its last value after about
a second. The page updates asynchronously (re-frame queues events, React renders in the
background), so tests wait for what they expect to show up rather than for a fixed time."
[f]
(js/Promise.
(fn [resolve]
(let [start (js/Date.now)
check (fn check []
(let [v (f)]
(cond
v (resolve {:ok? true :value v})
(> (- (js/Date.now) start) 1000) (resolve {:ok? false :value v})
:else (js/setTimeout check 2))))]
(check)))))
(defn eventually
"A promise of `(f)`, once it is truthy. If it isn't within about a second the test fails (with
the place that waited), so a wait that can't succeed doesn't pass unnoticed."
[f]
(let [waited-at (js/Error. "timed out waiting for the page")]
(-> (poll f)
(.then (fn [{:keys [ok? value]}]
(when-not ok?
(t/do-report {:type :fail :message "timed out waiting for the page"
:expected "the condition to become true"
:actual (str "still " (pr-str value) "\n" (.-stack waited-at))}))
value)))))
(defn q
"The first element of the page matching CSS `selector`, or nil."
[selector]
(.querySelector js/document selector))
(defn q-all [selector]
(vec (.querySelectorAll js/document selector)))
(defn text
"The text of the first element matching `selector`, or nil when there is none."
[selector]
(some-> (q selector) .-textContent))
(defn shows
"A promise that checks that the text of `selector` becomes `expected` (`what` says what it is)."
[what selector expected]
(-> (poll #(= expected (text selector)))
(.then (fn [_] (is (= expected (text selector)) what)))))
(defn by-label
"The element whose aria-label is `label`."
[label]
(q (str "[aria-label=\"" label "\"]")))
(defn click! [el]
(.click ^js el))
(defn type!
"Types `value` into an input: sets it the way the browser does and fires `input`, which is
what React's onChange listens to."
[el value]
;; window.Event, not the global one: under Node that is Node's own, which jsdom rejects.
(let [setter (.-set (js/Object.getOwnPropertyDescriptor js/HTMLInputElement.prototype "value"))]
(.call setter el value)
(.dispatchEvent el (js/window.Event. "input" #js {:bubbles true}))))
(defn submit!
"Submits the form `el` (an event, not requestSubmit, so it doesn't matter what the browser
would validate)."
[el]
(.dispatchEvent el (js/window.Event. "submit" #js {:bubbles true :cancelable true})))
(defonce ^:private root (atom nil))
(defn mount!
"Renders `component` (hiccup) into a fresh #app, as core/init does, and returns a promise."
[component]
(let [container (.getElementById js/document "app")]
(reset! root (rdc/create-root container))
(rdc/render @root component)
(js/Promise.resolve)))
(defn unmount!
"Removes what `mount!` rendered."
[]
(when-let [r @root]
(rdc/unmount r)
(reset! root nil)))
(defn steps
"Runs `fs` one after the other, as a promise: each is called with the result of the previous
one, which may be a promise, and the promise resolves to the result of the last."
[& fs]
(reduce (fn [p f] (.then p f)) (js/Promise.resolve) fs))
(defn finish
"Ends an `async` test when the promise `p` settles; a rejection fails the test."
[p done]
(-> p
(.then (fn [_] (done)))
(.catch (fn [e]
(t/do-report {:type :error :message "Uncaught exception, not in assertion."
:expected nil :actual e})
(done)))))
(def page-fixture
"Leaves the page empty after each test."
{:after unmount!})
ui/test/tbd/ui/views_test.cljs
+381
View File
@@ -0,0 +1,381 @@
(ns tbd.ui.views-test
"The page as a user sees it: rendered in jsdom, against a fake server, then typed into and
clicked. Everything from the DOM event to the request and back to the DOM is real."
(:require [clojure.string :as str]
[cljs.test :refer [deftest is testing async use-fixtures]]
[re-frame.core :as rf]
[re-frame.db :as rf-db]
[tbd.ui.db :as db]
[tbd.ui.events :as events]
[tbd.ui.test-util :as tu :refer [q q-all text shows steps click! type! submit!]]
[tbd.ui.views :as views]
[tbd.ui.webmcp :as webmcp]))
(use-fixtures :each
tu/fake-server-fixture
tu/page-fixture
;; The Copy button's 2 seconds are up when the test says so (see mcp-copy-button-test).
(tu/stub-effects-fixture {:dispatch-later (fn [_])}))
(defn- open-page!
"Starts the app as core/init does, minus the WebMCP widget."
[]
(rf/dispatch-sync [::events/initialize])
(tu/mount! [views/app]))
(defn- todos-section
"The todos, which are only on the page when someone is logged in."
[]
(q "input[name=title]"))
(defn- todo-titles []
(mapv #(str/trim (.-textContent %)) (q-all "ul li label")))
(defn- nav-links []
(mapv #(.-textContent %) (q-all "main > p:last-child a, main > p:last-child button")))
(defn- log-in-page!
"Opens the page with alice logged in, with `todos`, and waits for the list."
[todos]
(tu/log-in!)
(swap! tu/server assoc :todos todos :next-id (inc (count todos)))
(steps open-page!
#(tu/eventually todos-section)
#(tu/eventually (fn [] (or (q "ul li") (= "Nothing to do." (text "section > p")))))))
(def ^:private todo-1 {:id 1 :owner-id 7 :title "buy milk" :done false :created-at 1 :updated-at 1})
(def ^:private todo-2 {:id 2 :owner-id 7 :title "walk dog" :done true :created-at 2 :updated-at 2})
;; --- The page as a visitor sees it ---
(deftest anonymous-page-test
(async done
(tu/finish
(steps
open-page!
#(tu/eventually (fn [] (some #{"Log in"} (nav-links))))
(fn []
(is (= "tbd" (text "h1")))
(is (= ["API docs" "swagger.json" "Log in"] (nav-links)))
(is (= "/auth/login" (.getAttribute (q "a[href=\"/auth/login\"]") "href")))
(is (nil? (todos-section)) "no todos without a login")
(is (= ["Tic-tac-toe" "Add this MCP server to Claude Code" "Browser tools (WebMCP)"]
(mapv #(.-textContent %) (q-all "h2"))))))
done)))
(deftest login-state-error-test
;; When the page can't find out who is logged in, it offers neither Log in nor Log out.
(async done
(aset js/globalThis "fetch"
(fn [_ _] (js/Promise.resolve #js {:ok false :status 500
:text (fn [] (js/Promise.resolve (pr-str {:error "Boom"})))})))
(tu/finish
(steps
open-page!
#(tu/eventually (fn [] (= :error (get-in @rf-db/app-db [:user :status]))))
(fn []
(is (= ["API docs" "swagger.json"] (nav-links)))))
done)))
;; --- Calculator ---
(deftest calculator-test
(async done
(tu/finish
(steps
open-page!
#(tu/eventually (fn [] (q "input[name=x]")))
(fn []
(is (nil? (q "form [role=alert]")))
(type! (q "input[name=x]") "2")
(type! (q "input[name=y]") "3.5")
(tu/eventually (fn [] (= "3.5" (.-value (q "input[name=y]"))))))
(fn []
(is (= "2" (.-value (q "input[name=x]"))) "the field shows what was typed")
(submit! (q "form"))
(shows "the sum" "form [aria-live=polite]" "2 + 3.5 = 5.5"))
(fn []
(is (= "5.5" (text "form strong")))
(swap! tu/server assoc :add-error "Invalid parameters")
(submit! (q "form"))
(shows "the server's complaint" "form [role=alert]" "Invalid parameters (x)"))
(fn []
(is (nil? (q "form [aria-live=polite]")) "the old sum is gone")))
done)))
;; --- Todos ---
(deftest todos-empty-test
(async done
(tu/finish
(steps
#(log-in-page! [])
(fn []
(is (= "Nothing to do." (text "section > p")))
(is (= "Log out" (last (nav-links))))
(is (nil? (q "a[href=\"/auth/login\"]")))
(is (= "Signed in as alice" (.getAttribute (q "main > p:last-child button") "title")))))
done)))
(deftest todos-list-test
(async done
(tu/finish
(steps
#(log-in-page! [todo-1 todo-2])
(fn []
(is (= ["buy milk" "walk dog"] (todo-titles)))
(is (= [false true] (mapv #(.-checked %) (q-all "ul li input[type=checkbox]"))))
(is (= [nil "line-through"]
(mapv #(not-empty (.. % -style -textDecoration)) (q-all "ul li label"))))))
done)))
(deftest add-todo-test
(async done
(tu/finish
(steps
#(log-in-page! [todo-1])
(fn []
(type! (q "input[name=title]") "walk dog")
(submit! (q "section form")))
#(tu/eventually (fn [] (= 2 (count (todo-titles)))))
(fn []
(is (= ["buy milk" "walk dog"] (todo-titles)))
(is (= "" (.-value (q "input[name=title]"))) "the field is emptied")
(is (= ["buy milk" "walk dog"] (mapv :title (:todos @tu/server))) "the server has it")))
done)))
(deftest add-todo-error-test
(async done
(tu/finish
(steps
#(log-in-page! [todo-1])
(fn []
(type! (q "input[name=title]") " ")
(submit! (q "section form"))
(shows "the server's complaint" "section [role=alert]" "Invalid body (title)"))
(fn []
(is (= ["buy milk"] (todo-titles)))
(is (= " " (.-value (q "input[name=title]"))) "what was typed stays"))
(fn []
(type! (q "input[name=title]") "walk dog")
(submit! (q "section form"))
(tu/eventually (fn [] (nil? (q "section [role=alert]")))))
(fn [gone]
(is gone "the message goes when the next attempt works")))
done)))
(deftest tick-and-untick-test
(async done
(tu/finish
(steps
#(log-in-page! [todo-1])
(fn []
(click! (q "ul li input[type=checkbox]"))
(tu/eventually (fn [] (.-checked (q "ul li input[type=checkbox]")))))
(fn []
(is (true? (:done (first (:todos @tu/server)))) "the server has it")
(tu/eventually (fn [] (= "line-through" (.. (q "ul li label") -style -textDecoration)))))
(fn [struck]
(is struck "the title is struck through")
(click! (q "ul li input[type=checkbox]"))
(tu/eventually (fn [] (not (.-checked (q "ul li input[type=checkbox]"))))))
(fn [unticked]
(is unticked)
(is (false? (:done (first (:todos @tu/server)))))))
done)))
(deftest delete-todo-test
(async done
(tu/finish
(steps
#(log-in-page! [todo-1 todo-2])
(fn []
(click! (tu/by-label "Delete buy milk"))
(tu/eventually (fn [] (= ["walk dog"] (todo-titles)))))
(fn [_]
(is (= ["walk dog"] (todo-titles)))
(is (= [2] (mapv :id (:todos @tu/server))))
(click! (tu/by-label "Delete walk dog"))
(tu/eventually (fn [] (= "Nothing to do." (text "section > p")))))
(fn [emptied]
(is emptied "the empty list says so")))
done)))
(deftest todos-loading-test
;; The list is on its way: logged in, nothing to show yet.
(async done
(reset! rf-db/app-db (-> db/default-db
(assoc :user {:status :logged-in :login "alice"})
(assoc-in [:todos :status] :loading)))
(tu/finish
(steps
#(tu/mount! [views/app])
#(shows "the list says it is loading" "section > p" "Loading…"))
done)))
;; --- Logging out, and losing the session ---
(deftest log-out-test
(async done
(tu/finish
(steps
#(log-in-page! [todo-1])
(fn []
(click! (q "main > p:last-child button")))
#(tu/eventually (fn [] (some #{"Log in"} (nav-links))))
(fn []
(is (nil? (:user @tu/server)))
(is (nil? (todos-section)) "the todos are hidden")
(is (= ["API docs" "swagger.json" "Log in"] (nav-links)))))
done)))
(deftest expired-session-test
(async done
(tu/finish
(steps
#(log-in-page! [todo-1])
(fn []
;; The session ends behind the page's back; the next change is refused.
(swap! tu/server assoc :user nil)
(click! (q "ul li input[type=checkbox]")))
#(tu/eventually (fn [] (some #{"Log in"} (nav-links))))
(fn []
(is (nil? (todos-section)) "the page falls back to the logged-out view")))
done)))
;; --- Tic-tac-toe ---
(defn- cell
"The button of the cell at index `i` (0 is the top left): the labels count from 1."
[i]
(q (str "button[aria-label^=\"Cell " (inc i) "\"]")))
(defn- board []
(mapv #(str/trim (.-textContent %)) (q-all "section button[aria-label^=Cell]")))
(defn- play!
"Clicks the cells, one after the other, and waits until the page shows a mark in each."
[& cells]
(steps
(fn []
(doseq [n cells] (click! (cell n)))
(tu/eventually #(every? (fn [n] (seq (.-textContent (cell n)))) cells)))))
(defn- status [] (text "[role=status]"))
(deftest tic-tac-toe-test
(async done
(tu/finish
(steps
open-page!
#(tu/eventually (fn [] (q "[role=status]")))
(fn []
(is (= "X's turn" (status)))
(is (= (repeat 9 "") (board)))
(is (every? #(not (.-disabled %)) (q-all "section button[aria-label^=Cell]"))))
#(play! 4)
(fn []
(is (= ["" "" "" "" "X" "" "" "" ""] (board)))
(is (= "O's turn" (status)))
(is (.-disabled (cell 4)) "a taken cell can't be pressed again")
(is (= "Cell 5, X" (.getAttribute (cell 4) "aria-label"))))
#(play! 0 2 3 6)
(fn []
;; X 4, O 0, X 2, O 3, X 6: the diagonal 2-4-6.
(is (= "X wins!" (status)))
(is (= ["O" "" "X" "O" "X" "" "X" "" ""] (board)))
(is (every? #(.-disabled %) (q-all "section button[aria-label^=Cell]")) "the game is over")
(is (= ["gold" "gold" "gold"]
(mapv #(.. % -style -background)
(filter #(= "gold" (.. % -style -background)) (q-all "section button[aria-label^=Cell]"))))
"the winning line is highlighted")
(click! (q "section p button")))
#(tu/eventually (fn [] (= "X's turn" (status))))
(fn []
(is (= (repeat 9 "") (board)) "New game clears the board")))
done)))
(deftest tic-tac-toe-draw-test
(async done
(tu/finish
(steps
open-page!
#(tu/eventually (fn [] (q "[role=status]")))
;; X O X / X O O / O X X, played in turn: X 0, O 1, X 2, O 4, X 3, O 5, X 7, O 6, X 8.
#(play! 0 1 2 4 3 5 7 6 8)
(fn []
(is (= "It's a draw." (status)))
(is (empty? (filter #(= "gold" (.. % -style -background)) (q-all "section button[aria-label^=Cell]"))))))
done)))
;; --- The setup sections ---
(defn- with-clipboard
"Runs `f` with navigator.clipboard set to `clipboard`, and takes it away afterwards."
[clipboard f]
(js/Object.defineProperty js/navigator "clipboard" #js {:value clipboard :configurable true})
(-> (f)
(.finally #(js-delete js/navigator "clipboard"))))
(deftest mcp-setup-test
(async done
(tu/finish
(steps
open-page!
#(tu/eventually (fn [] (q "details")))
(fn []
(let [details (first (q-all "details"))]
(is (nil? (.getAttribute details "open")) "folded away to start with")
(is (= "Add this MCP server to Claude Code" (text "details summary")))
(is (= "claude mcp add --transport http tbd http://localhost:3000/mcp" (text "details pre code"))
"the command names the address the page was loaded from")
(is (= ["claude" "/mcp" "tbd"]
(mapv #(.-textContent %) (.querySelectorAll details "ol code")))))))
done)))
(deftest mcp-no-copy-button-without-clipboard-test
;; The Clipboard API only exists on secure pages; without it there is nothing to press.
(async done
(tu/finish
(steps
open-page!
#(tu/eventually (fn [] (q "details")))
(fn []
(is (nil? (q "details pre + button")))))
done)))
(deftest mcp-copy-button-test
(async done
(let [copied (atom [])]
(tu/finish
(with-clipboard
#js {:writeText (fn [s] (swap! copied conj s) (js/Promise.resolve))}
(fn []
(steps
open-page!
#(tu/eventually (fn [] (q "details pre + button")))
(fn []
(is (= "Copy" (text "details pre + button")))
(click! (q "details pre + button")))
#(shows "the button says so" "details pre + button" "Copied")
(fn []
(is (= ["claude mcp add --transport http tbd http://localhost:3000/mcp"] @copied))
;; The 2 seconds are up.
(rf/dispatch-sync [::events/mcp-copied-timeout]))
#(shows "the button is back" "details pre + button" "Copy"))))
done))))
(deftest browser-tools-test
(async done
(tu/finish
(steps
open-page!
#(tu/eventually (fn [] (second (q-all "details"))))
(fn []
(let [section (second (q-all "details"))]
(is (= "Browser tools (WebMCP)" (.-textContent (.querySelector section "summary"))))
(is (= (str (count webmcp/tools)) (.-textContent (.querySelector section "p strong")))
"it counts the tools the page really offers")
(is (= "https://webmcp.dev" (.getAttribute (.querySelector section "p a") "href")))
(is (= 4 (.-length (.querySelectorAll section "ol li")))))))
done)))
ui/test/tbd/ui/webmcp_test.cljs
+38 -60
View File
@@ -1,55 +1,12 @@
(ns tbd.ui.webmcp-test
(:require [cljs.reader :as reader]
[cljs.test :refer [deftest is testing async use-fixtures]]
(:require [cljs.test :refer [deftest is testing async use-fixtures]]
[re-frame.core :as rf]
[re-frame.db :as rf-db]
[tbd.ui.events :as events]
[tbd.ui.test-util :as tu]
[tbd.ui.webmcp :as webmcp]))
;; A fake browser: the page's server, and the WebMCP registry the tools end up in.
(def ^:private server
"What the fake server holds: {:user nil-or-{:login ..}, :todos [..], :next-id n}."
(atom nil))
(defn- respond [status body]
{:status status :body (pr-str body)})
(defn- route [method uri body]
(let [{:keys [user todos]} @server
todo-id (some->> (re-find #"^/api/todos/(\d+)$" uri) second js/parseInt)]
(cond
(= "/auth/me" uri) (if user (respond 200 user) (respond 401 {:error "not logged in"}))
(and (= "GET" method) (re-find #"^/api/add\?" uri))
(let [[_ x y] (re-find #"x=([^&]*)&y=([^&]*)" uri)]
(if-let [error (:add-error @server)]
(respond 400 {:error error :details {:x ["is wrong"]}})
(respond 200 {:result (+ (js/parseFloat x) (js/parseFloat y))})))
(not user) (respond 401 {:error "not logged in"})
(and (= "GET" method) (= "/api/todos" uri)) (respond 200 {:todos todos})
(and (= "POST" method) (= "/api/todos" uri))
(if (seq (.trim (:title body)))
(let [todo {:id (:next-id @server) :owner-id 7 :title (:title body) :done false
:created-at 1 :updated-at 1}]
(swap! server #(-> % (update :todos conj todo) (update :next-id inc)))
(respond 201 todo))
(respond 400 {:error "Invalid body" :details {:title ["must not be blank"]}}))
(and (= "PATCH" method) todo-id)
(if-let [todo (first (filter #(= todo-id (:id %)) todos))]
(let [changed (merge todo body)]
(swap! server update :todos (fn [ts] (mapv #(if (= todo-id (:id %)) changed %) ts)))
(respond 200 changed))
(respond 404 {:error "todo not found"}))
(and (= "DELETE" method) todo-id)
(do (swap! server update :todos (fn [ts] (filterv #(not= todo-id (:id %)) ts)))
(respond 200 {:deleted true}))
:else (respond 404 {:error "not found"}))))
(defn- fake-fetch [uri opts]
(let [opts (js->clj opts :keywordize-keys true)
{:keys [status body]} (route (:method opts) uri (some-> (:body opts) reader/read-string))]
(js/Promise.resolve
#js {:ok (< status 300) :status status :text (fn [] (js/Promise.resolve body))})))
;; A fake browser: the page's server (tbd.ui.test-util), and the WebMCP registry the tools end up in.
(def ^:private registered
"What the page registered with WebMCP: name -> {:description :input-schema :execute}."
@@ -62,15 +19,11 @@
:input-schema input-schema
:execute execute}))})
(def ^:private real-fetch (.-fetch js/globalThis))
(use-fixtures :each
{:before (fn []
(reset! registered {})
(reset! server {:user nil :todos [] :next-id 1})
(aset js/globalThis "fetch" fake-fetch))
:after (fn []
(aset js/globalThis "fetch" real-fetch))})
((:before tu/fake-server-fixture)))
:after (:after tu/fake-server-fixture)})
(defn- call
"A promise of the result of the tool `tool-name` on `args`, as {:text :error?}."
@@ -95,8 +48,6 @@
(rf/dispatch-sync [::events/initialize])
(webmcp/register-tools! fake-mcp))
(defn- log-in! [] (swap! server assoc :user {:login "alice" :id 7}))
(deftest registers-the-tools
(is (identical? fake-mcp (webmcp/register-tools! fake-mcp)))
(is (= (set (map :name webmcp/tools)) (set (keys @registered))))
@@ -139,7 +90,7 @@
(done))))))
(deftest add-shows-the-servers-error
(swap! server assoc :add-error "Invalid parameters")
(swap! tu/server assoc :add-error "Invalid parameters")
(open-page!)
(async done
(-> (page-loaded)
@@ -153,6 +104,33 @@
(is (re-find #"must be numbers" (:text r)))
(done))))))
(deftest login-state-unavailable
;; The server can't say who is logged in: the tools that need to know say so.
(aset js/globalThis "fetch"
(fn [_ _] (js/Promise.resolve #js {:ok false :status 500
:text (fn [] (js/Promise.resolve (pr-str {:error "Boom"})))})))
(open-page!)
(async done
(-> (call "whoami" {})
(.then (fn [r]
(is (= {:text "could not tell who is logged in: Boom" :error? false} r))
(call "list_todos" {})))
(.then (fn [r]
(is (= {:text "could not tell who is logged in: Boom" :error? true} r))
(done))))))
(deftest add-while-adding
(open-page!)
(async done
(-> (page-loaded)
(.then (fn [_]
;; A person pressed Add a moment ago and the sum hasn't come back.
(rf/dispatch-sync [::events/add])
(call "add" {:x 1 :y 2})))
(.then (fn [r]
(is (= {:text "an addition is already in progress" :error? true} r))
(done))))))
(deftest anonymous-user
(open-page!)
(async done
@@ -166,12 +144,12 @@
(call "create_todo" {:title "buy milk"})))
(.then (fn [r]
(is (:error? r))
(is (empty? (:todos @server)) "nothing was sent")
(is (empty? (:todos @tu/server)) "nothing was sent")
(done))))))
(deftest todos
(log-in!)
(swap! server assoc :todos [{:id 1 :owner-id 7 :title "old" :done false :created-at 1 :updated-at 1}]
(tu/log-in!)
(swap! tu/server assoc :todos [{:id 1 :owner-id 7 :title "old" :done false :created-at 1 :updated-at 1}]
:next-id 2)
(open-page!)
(async done
@@ -199,7 +177,7 @@
(is (true? (:done (json (:text r)))))
(is (true? (:done (last (get-in @rf-db/app-db [:todos :items])))))
;; Already ticked: nothing to do, and no request.
(swap! server assoc :todos [])
(swap! tu/server assoc :todos [])
(call "set_todo_done" {:id 2 :done true})))
(.then (fn [r]
(is (true? (:done (json (:text r)))))
@@ -219,7 +197,7 @@
(done))))))
(deftest create-todo-shows-the-servers-error
(log-in!)
(tu/log-in!)
(open-page!)
(async done
(-> (call "create_todo" {:title " "})