;;; test-duet-transfer.el --- Tests for transfer-spec + planning -*- 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 endpoint matrix (route + backend selection), transfer-spec
;; assembly, and the two pure planners (conflict resolution and move
;; sequencing).  Selection tests register the built-in rsync/TRAMP backends
;; into a let-bound registry so they run against a known, isolated set.  The
;; planners are pure: existence and conflict-resolution decisions are injected
;; as functions, so no test touches a real file.

;;; Code:

(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))

(defmacro test-duet-transfer--with-builtins (&rest body)
  "Run BODY with only the built-in backends registered, isolated."
  `(let ((duet--backend-registry nil))
     (duet--register-builtin-backends)
     ,@body))

(defun test-duet-transfer--classify (path)
  "Classify PATH; convenience wrapper for route tests."
  (duet--classify-path path))

;;; Route determination — every matrix cell

(ert-deftest test-duet-transfer-route-local-to-local ()
  (should (eq :local
             (duet--transfer-route (test-duet-transfer--classify "/tmp/a")
                                   (test-duet-transfer--classify "/tmp/b")
                                   nil))))

(ert-deftest test-duet-transfer-route-local-to-remote ()
  (should (eq :local-remote
             (duet--transfer-route (test-duet-transfer--classify "/tmp/a")
                                   (test-duet-transfer--classify "/ssh:host:/b")
                                   nil)))
  (should (eq :local-remote
             (duet--transfer-route (test-duet-transfer--classify "/ssh:host:/a")
                                   (test-duet-transfer--classify "/tmp/b")
                                   nil))))

(ert-deftest test-duet-transfer-route-remote-same-host ()
  (should (eq :remote-same-host
             (duet--transfer-route (test-duet-transfer--classify "/ssh:user@host:/a")
                                   (test-duet-transfer--classify "/ssh:user@host:/b")
                                   nil))))

(ert-deftest test-duet-transfer-route-remote-different-host-defaults-roundtrip ()
  (should (eq :remote-roundtrip
             (duet--transfer-route (test-duet-transfer--classify "/ssh:hostA:/a")
                                   (test-duet-transfer--classify "/ssh:hostB:/b")
                                   nil))))

(ert-deftest test-duet-transfer-route-remote-different-host-direct-only-on-override ()
  (should (eq :remote-direct
             (duet--transfer-route (test-duet-transfer--classify "/ssh:hostA:/a")
                                   (test-duet-transfer--classify "/ssh:hostB:/b")
                                   '(:direct-remote-to-remote t)))))

;;; Backend selection — the matrix

(ert-deftest test-duet-transfer-selects-rsync-for-local-pair ()
  (test-duet-transfer--with-builtins
   (should (eq 'rsync
              (duet-backend-name
               (duet--select-backend (test-duet-transfer--classify "/tmp/a")
                                     (test-duet-transfer--classify "/tmp/b")))))))

(ert-deftest test-duet-transfer-selects-rsync-for-local-ssh-pair ()
  (test-duet-transfer--with-builtins
   (should (eq 'rsync
              (duet-backend-name
               (duet--select-backend (test-duet-transfer--classify "/tmp/a")
                                     (test-duet-transfer--classify "/ssh:host:/b")))))))

(ert-deftest test-duet-transfer-falls-back-to-tramp-for-non-ssh-method ()
  "An FTP endpoint is not ssh-reachable, so rsync declines and TRAMP wins."
  (test-duet-transfer--with-builtins
   (should (eq 'tramp
              (duet-backend-name
               (duet--select-backend (test-duet-transfer--classify "/tmp/a")
                                     (test-duet-transfer--classify "/ftp:host:/b")))))))

;;; Transfer-spec assembly

(ert-deftest test-duet-transfer-spec-local-copy-shape ()
  "A local copy spec names the rsync backend, the local route, and an argv."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/tmp/a/file.txt") "/tmp/b" nil)))
     (should (eq 'rsync (plist-get spec :backend)))
     (should (eq :local (plist-get spec :route)))
     (should (equal '("/tmp/a/file.txt") (plist-get spec :sources)))
     (should (equal "/tmp/b" (plist-get spec :destination-directory)))
     (should (equal "rsync" (car (plist-get spec :argv))))
     (should (member "/tmp/a/file.txt" (plist-get spec :argv)))
     (should (eq t (plist-get spec :async))))))

(ert-deftest test-duet-transfer-spec-carries-route-for-remote ()
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/tmp/a/file.txt") "/ssh:host:/b" nil)))
     (should (eq 'rsync (plist-get spec :backend)))
     (should (eq :local-remote (plist-get spec :route))))))

(ert-deftest test-duet-transfer-spec-preserves-tramp-marker ()
  "A spec routed through TRAMP carries the in-process marker, not just nil argv."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/tmp/a/file.txt") "/ftp:host:/b" nil)))
     (should (eq 'tramp (plist-get spec :backend)))
     (should (eq t (plist-get spec :tramp)))
     (should (null (plist-get spec :argv))))))

;;; Route-specific rsync specs (a single argv only when <=1 endpoint is remote)

(ert-deftest test-duet-transfer-spec-local-to-remote-argv ()
  "local->remote builds one rsync argv with an ssh transport and a remote dest."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/tmp/a/f") "/ssh:user@host:/b" nil)))
     (should (eq :local-remote (plist-get spec :route)))
     (should (member "-e" (plist-get spec :argv)))
     (should (member "user@host:/b" (plist-get spec :argv)))
     (should (member "/tmp/a/f" (plist-get spec :argv))))))

(ert-deftest test-duet-transfer-spec-local-to-remote-honors-port ()
  "A remote endpoint port travels in the rsync ssh transport flag."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/tmp/a/f") "/ssh:host#2222:/b" nil)))
     (should (member "ssh -p 2222" (plist-get spec :argv))))))

(ert-deftest test-duet-transfer-spec-remote-to-local-argv ()
  "remote->local builds one rsync argv with the remote source."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/ssh:host:/a/f") "/tmp/b" nil)))
     (should (eq :local-remote (plist-get spec :route)))
     (should (member "host:/a/f" (plist-get spec :argv)))
     (should (member "/tmp/b" (plist-get spec :argv))))))

(ert-deftest test-duet-transfer-spec-same-host-remote-is-deferred ()
  "A same-host remote pair yields a deferred spec, not a direct rsync argv."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/ssh:user@host:/a/f") "/ssh:user@host:/b" nil)))
     (should (eq :remote-same-host (plist-get spec :route)))
     (should (null (plist-get spec :argv)))
     (should (eq 'rsync-remote-to-remote (plist-get spec :exec-mode)))
     (should (plist-get spec :src-endpoint))
     (should (plist-get spec :dst-endpoint)))))

(ert-deftest test-duet-transfer-spec-different-host-roundtrip-is-deferred ()
  "Different remote hosts default to a deferred round-trip, no direct argv."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/ssh:hostA:/a/f") "/ssh:hostB:/b" nil)))
     (should (eq :remote-roundtrip (plist-get spec :route)))
     (should (null (plist-get spec :argv)))
     (should (eq 'rsync-remote-to-remote (plist-get spec :exec-mode))))))

(ert-deftest test-duet-transfer-spec-direct-override-route ()
  "The direct override is recorded in the route; the spec stays deferred."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/ssh:hostA:/a/f") "/ssh:hostB:/b"
                                    '(:direct-remote-to-remote t))))
     (should (eq :remote-direct (plist-get spec :route)))
     (should (null (plist-get spec :argv)))
     (should (eq 'rsync-remote-to-remote (plist-get spec :exec-mode))))))

(ert-deftest test-duet-transfer-spec-async-explicit-nil ()
  "An explicit :async nil in opts is honored rather than defaulting to t."
  (test-duet-transfer--with-builtins
   (let ((spec (duet--transfer-spec '("/tmp/a") "/tmp/b" '(:async nil))))
     (should (null (plist-get spec :async))))))

(ert-deftest test-duet-rsync-normalizer-classifies-known-stderr ()
  "The rsync backend's normalizer maps known stderr signatures to classes."
  (test-duet-transfer--with-builtins
   (let ((rsync (duet-backend-by-name 'rsync)))
     (should (eq 'permission-denied
                (plist-get (duet--normalize-failure
                            rsync '(:exit 23 :stderr "rsync: Permission denied (13)"))
                           :class)))
     (should (eq 'destination-full
                (plist-get (duet--normalize-failure
                            rsync '(:exit 11 :stderr "No space left on device"))
                           :class)))
     (should (eq 'rsync-protocol-mismatch
                (plist-get (duet--normalize-failure
                            rsync '(:exit 12 :stderr "protocol version mismatch"))
                           :class))))))

;;; Conflict planning — pure, prompt-free

(ert-deftest test-duet-plan-conflicts-no-collisions-all-copy ()
  "With nothing at the destination, every item plans a plain copy."
  (let ((plan (duet--plan-conflicts '(("/a/x" . "/b/x") ("/a/y" . "/b/y"))
                                    (lambda (_d) nil)
                                    (lambda (_i) (error "resolver must not be called")))))
    (should (cl-every (lambda (e) (eq 'copy (plist-get e :action))) plan))))

(ert-deftest test-duet-plan-conflicts-resolver-skip-and-overwrite ()
  "The resolver's action is recorded for each colliding item."
  (let ((plan (duet--plan-conflicts '(("/a/x" . "/b/x"))
                                    (lambda (_d) t)
                                    (lambda (_i) 'skip))))
    (should (eq 'skip (plist-get (car plan) :action)))))

(ert-deftest test-duet-plan-conflicts-rename-computes-free-name ()
  "A rename action computes a destination name the existence check reports free."
  (let* ((taken '("/b/file.txt" "/b/file (1).txt"))
         (plan (duet--plan-conflicts '(("/a/file.txt" . "/b/file.txt"))
                                     (lambda (d) (member d taken))
                                     (lambda (_i) 'rename))))
    (should (eq 'rename (plist-get (car plan) :action)))
    (should (equal "file (2).txt" (plist-get (car plan) :new-name)))))

(ert-deftest test-duet-plan-conflicts-apply-to-all ()
  "An (action . all) resolution applies to every remaining collision unprompted."
  (let ((calls 0))
    (let ((plan (duet--plan-conflicts
                 '(("/a/x" . "/b/x") ("/a/y" . "/b/y") ("/a/z" . "/b/z"))
                 (lambda (_d) t)
                 (lambda (_i) (setq calls (1+ calls)) '(skip . all)))))
      (should (= 1 calls))
      (should (cl-every (lambda (e) (eq 'skip (plist-get e :action))) plan)))))

;;; Move planning — delete only after copy success

(ert-deftest test-duet-plan-move-pairs-copy-then-gated-delete ()
  "Each source gets a copy step and a delete step gated on its copy success."
  (let ((plan (duet--plan-move '("/a/x" "/a/y"))))
    (should (= 4 (length plan)))
    (dolist (step plan)
      (when (eq 'delete (plist-get step :op))
        (should (eq 'copy-success (plist-get step :gate)))))))

(ert-deftest test-duet-plan-move-no-ungated-delete ()
  "No delete step is ever emitted without the copy-success gate."
  (let ((plan (duet--plan-move '("/a/x" "/a/y" "/a/z"))))
    (should-not (cl-some (lambda (s) (and (eq 'delete (plist-get s :op))
                                          (not (plist-get s :gate))))
                         plan))))

(provide 'test-duet-transfer)
;;; test-duet-transfer.el ends here