;;; efinger-test.el --- Tests for efinger -*- lexical-binding: t; -*-

;; Copyright (C) 2026  Andros Fenollosa

;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Commentary:

;; ERT test suite for efinger.el.
;;
;; The integration tests spin up an ephemeral finger server *inside*
;; Emacs (via `make-network-process' with :server t) so no external
;; program or network access is required.  The sample .plan payload is
;; John Carmack's real DOOM source-release announcement, quoted in
;; <https://andros.dev/blog/79c99190/>.
;;
;; Run with:
;;   emacs --batch -L . -l test/efinger-test.el -f ert-run-tests-batch-and-exit
;;
;; The blackhole timeout test needs outbound routing and is skipped
;; unless EFINGER_NETWORK_TESTS is set in the environment.

;;; Code:

(require 'ert)
(require 'efinger)

(defconst efinger-test-plan
  (concat "-----------------------------------------\r\n"
          "John Carmack's .plan for Aug 18, 1997\r\n"
          "-----------------------------------------\r\n"
          "\r\n"
          "I get asked about the DOOM source code every once in a while,\r\n"
          "so here is a full status update.\r\n")
  "Sample .plan reply, in raw CRLF form, used by the integration tests.")

;;;; Helpers

(defun efinger-test--pump (seconds predicate)
  "Run the event loop up to SECONDS until PREDICATE returns non-nil."
  (let ((deadline (+ (float-time) seconds)))
    (while (and (< (float-time) deadline)
                (not (funcall predicate)))
      (accept-process-output nil 0.05)
      (sit-for 0.01))
    (funcall predicate)))

(defun efinger-test--make-server (payload received)
  "Start a one-shot finger server that replies with PAYLOAD.
RECEIVED is a one-element vector; the query line the client sends
is stored in its slot 0.  Return the server process."
  (make-network-process
   :name "efinger-test-server"
   :server t
   :host 'local
   :service t
   :family 'ipv4
   :coding 'utf-8
   :filter (lambda (connection string)
             (aset received 0 string)
             (process-send-string connection payload)
             (delete-process connection))))

(defun efinger-test--closed-port ()
  "Return a loopback port number with nothing listening on it."
  (let* ((server (make-network-process
                  :name "efinger-test-probe" :server t
                  :host 'local :service t :family 'ipv4))
         (port (process-contact server :service)))
    (delete-process server)
    port))

;;;; Account parsing

(ert-deftest efinger-test-parse-user-host ()
  (let ((account (efinger--parse-account "johnc@idsoftware.com")))
    (should (equal (plist-get account :user) "johnc"))
    (should (equal (plist-get account :host) "idsoftware.com"))
    (should (eql (plist-get account :port) 79))
    (should (equal (plist-get account :label) "johnc@idsoftware.com"))))

(ert-deftest efinger-test-parse-labelled-with-port ()
  (let ((account (efinger--parse-account
                  '("Carmack" "johnc@example.com:1079"))))
    (should (equal (plist-get account :label) "Carmack"))
    (should (equal (plist-get account :user) "johnc"))
    (should (equal (plist-get account :host) "example.com"))
    (should (eql (plist-get account :port) 1079))))

(ert-deftest efinger-test-parse-host-only ()
  (let ((account (efinger--parse-account "happynetbox.com")))
    (should (equal (plist-get account :user) ""))
    (should (equal (plist-get account :host) "happynetbox.com"))))

(ert-deftest efinger-test-parse-invalid ()
  (should-error (efinger--parse-account 42)))

(ert-deftest efinger-test-account-title ()
  (should (equal (efinger--account-title
                  (efinger--parse-account "johnc@idsoftware.com"))
                 "johnc@idsoftware.com"))
  (should (equal (efinger--account-title
                  (efinger--parse-account "johnc@example.com:1079"))
                 "johnc@example.com:1079"))
  (should (equal (efinger--account-title
                  (efinger--parse-account "happynetbox.com"))
                 "happynetbox.com")))

(ert-deftest efinger-test-finger-query ()
  (let ((account (efinger--parse-account "johnc@idsoftware.com")))
    (let ((efinger-forward-host nil))
      (should (equal (efinger--finger-query account) "johnc")))
    (let ((efinger-forward-host t))
      (should (equal (efinger--finger-query account)
                     "johnc@idsoftware.com"))))
  ;; Host-only listing sends an empty query regardless of forwarding.
  (let ((account (efinger--parse-account "happynetbox.com"))
        (efinger-forward-host t))
    (should (equal (efinger--finger-query account) ""))))

(ert-deftest efinger-test-strip-cr ()
  (should (equal (efinger--strip-cr "a\r\nb\r\n") "a\nb\n")))

;;;; Integration: async fetch

(ert-deftest efinger-test-fetch-serves-plan ()
  "A responding server delivers its .plan into the buffer, CRs stripped."
  (let* ((received (make-vector 1 nil))
         (server (efinger-test--make-server efinger-test-plan received))
         (port (process-contact server :service))
         (buffer (generate-new-buffer " *efinger-test-plan*")))
    (unwind-protect
        (progn
          (with-current-buffer buffer (efinger-plan-mode))
          (efinger--start
           buffer (list :label "test" :user "johnc"
                        :host "127.0.0.1" :port port))
          (should (efinger-test--pump
                   5 (lambda ()
                       (with-current-buffer buffer
                         (string-match-p "status update" (buffer-string))))))
          ;; The bare username reached the server.
          (should (equal (string-trim (aref received 0)) "johnc"))
          (with-current-buffer buffer
            (should (string-match-p "John Carmack's .plan" (buffer-string)))
            ;; Header title is present and CRs are gone.
            (should (string-prefix-p "johnc@127.0.0.1" (buffer-string)))
            (should-not (string-match-p "\r" (buffer-string)))
            ;; The transient status placeholder was replaced.
            (should-not (string-match-p "Fingering" (buffer-string)))))
      (when (process-live-p server) (delete-process server))
      (kill-buffer buffer))))

(ert-deftest efinger-test-fetch-connection-refused ()
  "A refused connection is reported gracefully, without a backtrace."
  (let ((buffer (generate-new-buffer " *efinger-test-refused*"))
        (port (efinger-test--closed-port))
        (efinger-connection-timeout 3))
    (unwind-protect
        (progn
          (with-current-buffer buffer (efinger-plan-mode))
          (efinger--start
           buffer (list :label "x" :user "x" :host "127.0.0.1" :port port))
          (should (efinger-test--pump
                   5 (lambda ()
                       (with-current-buffer buffer
                         (string-match-p "Could not connect\\|timed out"
                                         (buffer-string))))))
          (with-current-buffer buffer
            (should (string-match-p "Could not connect" (buffer-string)))))
      (kill-buffer buffer))))

(ert-deftest efinger-test-fetch-returns-immediately ()
  "The async fetch returns control at once, whatever the host does."
  (let ((buffer (generate-new-buffer " *efinger-test-immediate*"))
        (port (efinger-test--closed-port))
        (efinger-connection-timeout 10))
    (unwind-protect
        (let* ((start (float-time))
               (_ (with-current-buffer buffer (efinger-plan-mode)))
               (proc (efinger--start
                      buffer
                      (list :label "x" :user "x" :host "127.0.0.1" :port port)))
               (elapsed (- (float-time) start)))
          (should (< elapsed 1.0))
          (should (eq (process-status proc) 'connect)))
      (kill-buffer buffer))))

(ert-deftest efinger-test-timeout ()
  "A silent host is abandoned after `efinger-connection-timeout' seconds."
  (skip-unless (getenv "EFINGER_NETWORK_TESTS"))
  (let ((buffer (generate-new-buffer " *efinger-test-timeout*"))
        (efinger-connection-timeout 2))
    (unwind-protect
        (progn
          (with-current-buffer buffer (efinger-plan-mode))
          (efinger--start
           buffer (list :label "bh" :user "x" :host "10.255.255.1" :port 79))
          (should (efinger-test--pump
                   6 (lambda ()
                       (with-current-buffer buffer
                         (string-match-p "timed out" (buffer-string)))))))
      (kill-buffer buffer))))

(ert-deftest efinger-test-live-happynetbox ()
  "Optional live check against a real public finger server."
  (skip-unless (getenv "EFINGER_NETWORK_TESTS"))
  (let ((buffer (generate-new-buffer " *efinger-test-live*")))
    (unwind-protect
        (progn
          (with-current-buffer buffer (efinger-plan-mode))
          (efinger--start
           buffer (efinger--parse-account "random@happynetbox.com"))
          (should (efinger-test--pump
                   15 (lambda ()
                        (with-current-buffer buffer
                          (> (- (point-max) (point-min)) 60))))))
      (kill-buffer buffer))))

(provide 'efinger-test)
;;; efinger-test.el ends here