diff options
Diffstat (limited to 'tests/test-duet-backend.el')
| -rw-r--r-- | tests/test-duet-backend.el | 231 |
1 files changed, 231 insertions, 0 deletions
diff --git a/tests/test-duet-backend.el b/tests/test-duet-backend.el new file mode 100644 index 0000000..b1d9c34 --- /dev/null +++ b/tests/test-duet-backend.el @@ -0,0 +1,231 @@ +;;; test-duet-backend.el --- Tests for the duet backend registry -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the transport-backend registry, scorer, redaction helper, +;; failure-normalizer interface, and the tiered contract-check functions. +;; The machinery is exercised with fake backends defined here; the concrete +;; rsync/TRAMP backends register in Phase 3 once their command builders exist. +;; +;; Each test rebinds `duet--backend-registry' to nil so registrations never +;; leak between tests (no shared mutable state). + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +(defun test-duet-backend--fake (name score &rest overrides) + "Build a well-formed fake backend named NAME whose scorer returns SCORE. +OVERRIDES is a plist that wins over the conservative defaults. It is spliced +ahead of the defaults because cl-defstruct constructors take the leftmost +value for a duplicated keyword." + (apply #'duet-backend-create + (append + overrides + (list :name name + :handles (lambda (_src _dst) score) + :command (lambda (_src _dst _opts) + (list :argv (list "echo" (symbol-name name)) + :default-directory "/")) + :capabilities '(:async t) + :redaction '("\\(password=\\)[^ \n]+"))))) + +;;; Registry — add, find, replace, order + +(ert-deftest test-duet-backend-register-and-find () + "A registered backend is retrievable by name." + (let ((duet--backend-registry nil)) + (duet-register-backend (test-duet-backend--fake 'alpha 10)) + (should (duet-backend-p (duet-backend-by-name 'alpha))) + (should (= 1 (length (duet-backends)))))) + +(ert-deftest test-duet-backend-register-replaces-same-name () + "Re-registering a name replaces the prior backend rather than duplicating." + (let ((duet--backend-registry nil)) + (duet-register-backend (test-duet-backend--fake 'alpha 10)) + (duet-register-backend (test-duet-backend--fake 'alpha 99)) + (should (= 1 (length (duet-backends)))) + (should (= 99 (funcall (duet-backend-handles (duet-backend-by-name 'alpha)) + nil nil))))) + +(ert-deftest test-duet-backend-register-newest-first () + "The most recently registered backend sorts ahead of older ones." + (let ((duet--backend-registry nil)) + (duet-register-backend (test-duet-backend--fake 'alpha 10)) + (duet-register-backend (test-duet-backend--fake 'beta 20)) + (should (equal '(beta alpha) + (mapcar #'duet-backend-name (duet-backends)))))) + +;;; Scoring — lowest wins, nil skips, ties break by recency + +(ert-deftest test-duet-backend-select-lowest-score-wins () + "The backend with the lowest score handles the pair." + (let ((duet--backend-registry nil)) + (duet-register-backend (test-duet-backend--fake 'expensive 50)) + (duet-register-backend (test-duet-backend--fake 'cheap 5)) + (should (eq 'cheap (duet-backend-name (duet--select-backend nil nil)))))) + +(ert-deftest test-duet-backend-select-skips-nil-scorers () + "A backend whose scorer returns nil cannot handle the pair and is skipped." + (let ((duet--backend-registry nil)) + (duet-register-backend (test-duet-backend--fake 'declines nil)) + (duet-register-backend (test-duet-backend--fake 'handles 30)) + (should (eq 'handles (duet-backend-name (duet--select-backend nil nil)))))) + +(ert-deftest test-duet-backend-select-none-handles-returns-nil () + "When no backend scores the pair, selection returns nil." + (let ((duet--backend-registry nil)) + (duet-register-backend (test-duet-backend--fake 'a nil)) + (duet-register-backend (test-duet-backend--fake 'b nil)) + (should (null (duet--select-backend nil nil))))) + +(ert-deftest test-duet-backend-select-tie-breaks-by-recency () + "Equal scores resolve to the most recently registered backend." + (let ((duet--backend-registry nil)) + (duet-register-backend (test-duet-backend--fake 'older 10)) + (duet-register-backend (test-duet-backend--fake 'newer 10)) + (should (eq 'newer (duet-backend-name (duet--select-backend nil nil)))))) + +;;; Redaction + +(ert-deftest test-duet-redact-replaces-pattern-matches () + "A pattern's secret is redacted while its group-1 label is kept." + (let ((out (duet--redact "ssh password=hunter2 host=example" + '("\\(password=\\)[^ \n]+")))) + (should (string-match-p "password=<redacted>" out)) + (should-not (string-match-p "hunter2" out)) + (should (string-match-p "host=example" out)))) + +(ert-deftest test-duet-redact-applies-every-pattern () + "Multiple patterns each redact independently." + (let ((out (duet--redact "token=abc secret=def" + '("\\(token=\\)[^ \n]+" "\\(secret=\\)[^ \n]+")))) + (should-not (string-match-p "abc" out)) + (should-not (string-match-p "def" out)))) + +(ert-deftest test-duet-redact-no-patterns-returns-input () + "With no patterns the text is returned unchanged." + (should (equal "nothing here" (duet--redact "nothing here" nil)))) + +(ert-deftest test-duet-redact-none-returns-input () + "A backend declaring :none (no secret surface) redacts nothing." + (should (equal "user@host:/path" (duet--redact "user@host:/path" :none)))) + +;;; Failure normalizer — minimal mapping and shape + +(ert-deftest test-duet-normalize-failure-shape-has-all-keys () + "A normalized failure carries class, cause, evidence, safety, next-actions." + (let ((n (duet--normalize-failure + (test-duet-backend--fake 'x 1) + '(:exit 1 :stderr "boom")))) + (should (plist-member n :class)) + (should (plist-member n :cause)) + (should (plist-member n :evidence)) + (should (plist-member n :safety)) + (should (plist-member n :next-actions)))) + +(ert-deftest test-duet-normalize-failure-launch-error () + "A launch error classifies as launch-failure." + (let ((n (duet--normalize-failure + (test-duet-backend--fake 'x 1) + '(:launch-error "No such file or directory")))) + (should (eq 'launch-failure (plist-get n :class))))) + +(ert-deftest test-duet-normalize-failure-unknown-nonzero-exit () + "An unrecognized nonzero exit falls back to backend-unknown-failure." + (let ((n (duet--normalize-failure + (test-duet-backend--fake 'x 1) + '(:exit 42 :stderr "weird")))) + (should (eq 'backend-unknown-failure (plist-get n :class))))) + +;;; Failure-pattern mechanism + +(ert-deftest test-duet-failure-patterns-match-by-stderr-regexp () + "A pattern whose :match regexp hits stderr supplies its class and cause." + (let* ((normalizer + (duet-define-cli-failure-patterns + '((:match "Permission denied" :class permission-denied + :cause "The destination rejected the write." + :next-actions (fix-permissions) + :safety "Source unchanged.")))) + (n (funcall normalizer '(:exit 23 :stderr "rsync: Permission denied (13)")))) + (should (eq 'permission-denied (plist-get n :class))) + (should (equal '(fix-permissions) (plist-get n :next-actions))))) + +(ert-deftest test-duet-failure-patterns-fall-back-to-minimal () + "When no pattern matches, the normalizer falls back to the minimal mapping." + (let* ((normalizer + (duet-define-cli-failure-patterns + '((:match "Permission denied" :class permission-denied + :cause "..." :next-actions (fix-permissions))))) + (n (funcall normalizer '(:exit 99 :stderr "totally different")))) + (should (eq 'backend-unknown-failure (plist-get n :class))))) + +(ert-deftest test-duet-normalize-failure-uses-backend-normalizer () + "A backend carrying a normalizer has it consulted before the minimal mapping." + (let* ((normalizer + (duet-define-cli-failure-patterns + '((:match "rate" :class rate-limited :cause "Throttled." + :next-actions (retry-later))))) + (backend (test-duet-backend--fake 'cloud 1 :normalizer normalizer)) + (n (duet--normalize-failure backend '(:exit 1 :stderr "API rate exceeded")))) + (should (eq 'rate-limited (plist-get n :class))))) + +;;; Contract checks — tiered + +(ert-deftest test-duet-backend-check-minimum-passes-clean-backend () + "A well-formed fake backend reports no minimum-tier violations." + (should (null (duet-backend-check-minimum (test-duet-backend--fake 'good 10))))) + +(ert-deftest test-duet-backend-check-minimum-flags-missing-redaction () + "A backend that declares no redaction metadata fails the minimum tier." + (let ((b (test-duet-backend--fake 'noredact 10 :redaction nil))) + (should (duet-backend-check-minimum b)))) + +(ert-deftest test-duet-backend-check-minimum-accepts-none-redaction () + "A backend with no secret surface declares :none and passes the minimum tier." + (let ((b (test-duet-backend--fake 'localonly 10 :redaction :none))) + (should (null (duet-backend-check-minimum b))))) + +(ert-deftest test-duet-backend-check-minimum-flags-shell-string-command () + "A command builder returning a shell string instead of an argv list fails." + (let ((b (test-duet-backend--fake 'shellish 10 + :command (lambda (_s _d _o) + (list :shell-command "rm -rf /"))))) + (should (duet-backend-check-minimum b)))) + +(ert-deftest test-duet-backend-check-publishable-flags-missing-cleanup () + "The publishable tier additionally requires declared cleanup semantics." + (let ((b (test-duet-backend--fake 'pub 10 + :normalizer (duet-define-cli-failure-patterns nil)))) + ;; cleanup slot is unset, so publishable must flag it even though minimum passes. + (should (null (duet-backend-check-minimum b))) + (should (duet-backend-check-publishable b)))) + +(ert-deftest test-duet-backend-check-publishable-includes-minimum () + "Publishable problems are a superset of the minimum-tier problems." + (let* ((b (test-duet-backend--fake 'broken 10 :redaction nil)) + (min (duet-backend-check-minimum b)) + (pub (duet-backend-check-publishable b))) + (should min) + (should (cl-every (lambda (p) (member p pub)) min)))) + +(provide 'test-duet-backend) +;;; test-duet-backend.el ends here |