feat: add the transport-backend registry and contract checks

This is the seam every transport plugs into (Phase 2 in the design spec). A duet-backend struct carries a scorer, a command builder, capability flags, and contract metadata; duet-register-backend keeps a registry where re-registering a name replaces the prior backend, which is how a user or plugin overrides a built-in. duet--select-backend asks every backend to score an endpoint pair and picks the lowest cost, breaking ties toward the most recently registered.

The failure-normalizer interface turns a raw process failure into a class, a cause, evidence, a safety outcome, and next actions. Backends supply a pattern table via duet-define-cli-failure-patterns; anything unmatched falls back to a minimal normalizer that covers launch failure, missing executable, stall, signal, and unknown exit. This is what will let DUET explain a failure instead of dumping stderr.

Secrets are redacted before they reach a log: a pattern keeps its group-1 field label and strips the value, and a backend with no secret surface declares :none rather than an empty pattern list, so a forgotten declaration (nil) stays distinguishable from a deliberate one.

The tiered contract checks (minimum, publishable, capability) return a list of violations a backend author asserts is empty in one ERT test. The built-in rsync and TRAMP backends register through this same API in Phase 3, once their command builders land; here the machinery is exercised by fake backends.

1 files changed, 251 insertions, 1 deletions

diff --git a/duet.el b/duet.el
index 9ab858b..66b9a8a 100644
--- a/duet.el
+++ b/duet.el
@@ -34,6 +34,7 @@
 ;;; Code:
 
 (require 'tramp)
+(require 'cl-lib)
 
 (defgroup duet nil
   "Dual-pane file commander over dirvish/dired."
@@ -80,11 +81,260 @@ than signaling.  Validating raw TRAMP input is the connection reader's job."
           :localname (expand-file-name path)
           :hop nil)))
 
+;;; Transport-backend registry
+
+(cl-defstruct (duet-backend (:constructor duet-backend-create) (:copier nil))
+  "A transport backend: a scorer, a command builder, and contract metadata.
+
+Slots:
+
+  name          unique symbol; re-registering a name replaces the backend
+  handles       (lambda (SRC DST) ...) -> numeric cost (lower preferred) or
+                nil when the backend cannot handle the endpoint pair
+  command       (lambda (SRC DST OPTS) ...) -> a process-spec plist (its
+                :argv is an argument list, never a shell string)
+  capabilities  plist of advertised flags: :async :resume :bidirectional
+                :progress
+  temp-pattern  regexp naming the backend's temp/partial files, or nil
+  cleanup       cleanup semantics: `:verifiable', `:best-effort', or `:none'
+  redaction     list of regexps whose matches are stripped from logs (each
+                pattern's capture group 1 is the field label kept verbatim),
+                or the symbol `:none' for a backend with no secret surface
+  normalizer    failure-normalizer function, or nil to use the minimal one"
+  name handles command capabilities temp-pattern cleanup redaction normalizer)
+
+(defvar duet--backend-registry nil
+  "List of registered `duet-backend' structs, most recently registered first.")
+
+(defun duet-register-backend (backend)
+  "Register BACKEND, replacing any existing backend of the same name.
+Re-registering a name is how a user or plugin overrides a built-in.  Return
+BACKEND."
+  (setq duet--backend-registry
+        (cons backend
+              (cl-remove (duet-backend-name backend)
+                         duet--backend-registry
+                         :key #'duet-backend-name)))
+  backend)
+
+(defun duet-backends ()
+  "Return the registered backends, most recently registered first."
+  duet--backend-registry)
+
+(defun duet-backend-by-name (name)
+  "Return the registered backend named NAME, or nil."
+  (cl-find name duet--backend-registry :key #'duet-backend-name))
+
+(defun duet--select-backend (src dst)
+  "Return the registered backend best suited to transfer SRC to DST.
+Each backend's scorer is called with the classified endpoints SRC and DST and
+returns a numeric cost (lower preferred) or nil when it cannot handle the
+pair.  The lowest-cost backend wins; ties resolve to the most recently
+registered one.  Return nil when no backend handles the pair."
+  (let ((best nil) (best-score nil))
+    (dolist (b duet--backend-registry best)
+      (let ((score (funcall (duet-backend-handles b) src dst)))
+        (when (and (numberp score)
+                   (or (null best-score) (< score best-score)))
+          (setq best b
+                best-score score))))))
+
+;;; Secret redaction
+
+(defconst duet--redaction-marker "<redacted>"
+  "Replacement text substituted for matched secrets in logs and bug reports.")
+
+(defun duet--redact (text patterns)
+  "Return TEXT with every regexp in PATTERNS redacted.
+Each pattern keeps its capture group 1 (the field label) and replaces the
+rest of the match with the redaction marker, so a log can show that a secret
+field was present without leaking its value.  A pattern with no group 1
+redacts the whole match.  TEXT is returned unchanged when PATTERNS is nil or
+the symbol `:none' (a backend declaring it has no secret surface)."
+  (if (or (null patterns) (eq patterns :none))
+      text
+    (let ((out text))
+      (dolist (re patterns out)
+        (setq out (replace-regexp-in-string
+                   re
+                   (lambda (match)
+                     (save-match-data
+                       (if (and (string-match re match) (match-beginning 1))
+                           (concat (match-string 1 match) duet--redaction-marker)
+                         duet--redaction-marker)))
+                   out t t))))))
+
+;;; Failure normalization
+
+(defun duet--failure-evidence (context)
+  "Return the evidence lines from a failure CONTEXT as a list of strings."
+  (delq nil (list (plist-get context :launch-error)
+                  (plist-get context :stderr))))
+
+(defun duet-backend-minimal-failure-normalizer (context)
+  "Map a generic failure CONTEXT into a normalized explanation plist.
+CONTEXT is a plist with any of :launch-error, :executable-missing, :timeout,
+:signal, :exit, and :stderr.  The result carries :class, :cause, :evidence,
+:safety, and :next-actions.  Every backend gets this for free; a backend's
+own normalizer refines the classification for failures it recognizes."
+  (let ((exit (plist-get context :exit))
+        (signal (plist-get context :signal))
+        (evidence (duet--failure-evidence context)))
+    (cond
+     ((plist-get context :executable-missing)
+      (list :class 'missing-executable
+            :cause "The backend program was not found on PATH."
+            :evidence evidence :safety "Source unchanged; nothing ran."
+            :next-actions '(run-doctor)))
+     ((plist-get context :launch-error)
+      (list :class 'launch-failure
+            :cause "DUET could not launch the backend process."
+            :evidence evidence :safety "Source unchanged; nothing ran."
+            :next-actions '(run-doctor)))
+     ((plist-get context :timeout)
+      (list :class 'stalled
+            :cause "The transfer produced no output before the stall timeout."
+            :evidence evidence
+            :safety "Source unchanged; the destination may hold a partial."
+            :next-actions '(retry cancel)))
+     (signal
+      (list :class 'cancelled
+            :cause (format "The backend was terminated by signal %s." signal)
+            :evidence evidence
+            :safety "Source unchanged; the destination may hold a partial."
+            :next-actions '(retry)))
+     ((and (integerp exit) (/= exit 0))
+      (list :class 'backend-unknown-failure
+            :cause (format "The backend exited with status %d." exit)
+            :evidence evidence :safety :generic
+            :next-actions '(retry run-doctor)))
+     (t
+      (list :class 'backend-unknown-failure
+            :cause "The backend failed for an unrecognized reason."
+            :evidence evidence :safety :generic
+            :next-actions '(run-doctor))))))
+
+(defun duet--failure-pattern-match-p (match context)
+  "Return non-nil when MATCH applies to failure CONTEXT.
+MATCH is a regexp tested against the context's :stderr, or a predicate
+function called with the whole context."
+  (cond
+   ((functionp match) (funcall match context))
+   ((stringp match)
+    (let ((stderr (plist-get context :stderr)))
+      (and stderr (string-match-p match stderr))))
+   (t nil)))
+
+(defun duet--apply-failure-pattern (pattern context)
+  "Return a normalized failure for PATTERN if it matches CONTEXT, else nil."
+  (when (duet--failure-pattern-match-p (plist-get pattern :match) context)
+    (list :class (plist-get pattern :class)
+          :cause (plist-get pattern :cause)
+          :evidence (duet--failure-evidence context)
+          :safety (or (plist-get pattern :safety) :generic)
+          :next-actions (plist-get pattern :next-actions))))
+
+(defun duet-define-cli-failure-patterns (patterns)
+  "Return a failure-normalizer function built from PATTERNS.
+Each entry is a plist with :match (a regexp over stderr or a predicate over
+the context), :class, :cause, :next-actions, and an optional :safety.  The
+returned function tries each pattern in order and falls back to
+`duet-backend-minimal-failure-normalizer' when none match."
+  (lambda (context)
+    (or (cl-some (lambda (p) (duet--apply-failure-pattern p context)) patterns)
+        (duet-backend-minimal-failure-normalizer context))))
+
+(defun duet--normalize-failure (backend context)
+  "Normalize a failure CONTEXT for BACKEND into an explanation plist.
+Consult BACKEND's own normalizer when it has one, otherwise the minimal
+normalizer."
+  (funcall (or (duet-backend-normalizer backend)
+               #'duet-backend-minimal-failure-normalizer)
+           context))
+
+;;; Backend contract checks (tiered)
+
+(defun duet--check-name (backend)
+  "Return a minimum-tier name violation for BACKEND, or nil."
+  (unless (and (duet-backend-name backend)
+               (symbolp (duet-backend-name backend)))
+    "name must be a non-nil symbol"))
+
+(defun duet--check-handles (backend src dst)
+  "Return a minimum-tier scorer violation for BACKEND on SRC/DST, or nil."
+  (if (not (functionp (duet-backend-handles backend)))
+      "handles must be a function"
+    (let ((score (funcall (duet-backend-handles backend) src dst)))
+      (unless (or (null score) (numberp score))
+        "handles must return a number or nil"))))
+
+(defun duet--check-command (backend src dst opts)
+  "Return a minimum-tier command violation for BACKEND on SRC/DST/OPTS, or nil."
+  (if (not (functionp (duet-backend-command backend)))
+      "command must be a function"
+    (let ((spec (funcall (duet-backend-command backend) src dst opts)))
+      (cond
+       ((not (listp spec)) "command must return a process-spec plist")
+       ((plist-get spec :shell-command) "command must not build a shell string; use :argv")
+       ((not (listp (plist-get spec :argv))) "command :argv must be an argument list")))))
+
+(defun duet--check-redaction (backend)
+  "Return a minimum-tier redaction violation for BACKEND, or nil.
+A backend declares either a non-empty list of regexps or `:none' (no secret
+surface).  An unset slot (nil) is a forgotten declaration and is flagged."
+  (let ((r (duet-backend-redaction backend)))
+    (unless (or (eq r :none) (and (listp r) r))
+      "redaction metadata must be declared (a non-empty list of regexps, or :none)")))
+
+(defun duet--check-normalizer (backend)
+  "Return a minimum-tier failure-explainer violation for BACKEND, or nil."
+  (let ((n (duet--normalize-failure backend '(:exit 1 :stderr "sample"))))
+    (unless (and (plist-member n :class)
+                 (plist-member n :cause)
+                 (plist-member n :next-actions))
+      "failure normalizer must return a class/cause/next-actions plist")))
+
+(defun duet-backend-check-minimum (backend &optional src dst opts)
+  "Return a list of minimum-tier contract violations for BACKEND, or nil.
+SRC, DST, and OPTS are a sample endpoint pair and options the backend should
+handle; they default to a local-to-local pair.  An empty result means
+BACKEND is registrable: it names itself, scores and builds an argv command
+for the sample (never a shell string), declares redaction metadata, and
+produces a well-formed failure explanation.  An author wraps this in an ERT
+test: (should-not (duet-backend-check-minimum my-backend))."
+  (let ((src (or src '(:locality local :localname "/tmp/a")))
+        (dst (or dst '(:locality local :localname "/tmp/b"))))
+    (delq nil (list (duet--check-name backend)
+                    (duet--check-handles backend src dst)
+                    (duet--check-command backend src dst opts)
+                    (duet--check-redaction backend)
+                    (duet--check-normalizer backend)))))
+
+(defun duet-backend-check-publishable (backend &optional src dst opts)
+  "Return minimum-tier violations for BACKEND plus publishable-tier ones.
+A publishable backend additionally declares cleanup semantics and carries its
+own failure normalizer, so DUET can recommend it safely."
+  (append (duet-backend-check-minimum backend src dst opts)
+          (delq nil
+                (list (unless (duet-backend-cleanup backend)
+                        "cleanup semantics must be declared (:verifiable/:best-effort/:none)")
+                      (unless (duet-backend-normalizer backend)
+                        "a backend-specific failure normalizer is required to publish")))))
+
+(defun duet-backend-check-capability (backend capability &optional src dst opts)
+  "Return publishable-tier violations for BACKEND plus a CAPABILITY assertion.
+CAPABILITY (e.g. :resume) must be declared in the backend's `capabilities'
+before DUET will trust it."
+  (append (duet-backend-check-publishable backend src dst opts)
+          (delq nil
+                (list (unless (plist-get (duet-backend-capabilities backend) capability)
+                        (format "capability %s is asserted but not declared" capability))))))
+
 ;;;###autoload
 (defun duet ()
   "Launch the DUET dual-pane file commander."
   (interactive)
-  (user-error "DUET is not yet implemented — see the design document"))
+  (user-error "DUET is not yet implemented; see the design document"))
 
 (provide 'duet)
 ;;; duet.el ends here