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

;;; Commentary:

;; Keepalive timer lifecycle.

;;; Code:

(require 'cl-lib)
(require 'ert)
(require 'jabber-keepalive)

(defvar system-sleep-event-functions)

(defun jabber-test-keepalive--mock-timer-p (object)
  "Return non-nil when OBJECT is a mock keepalive timer."
  (and (consp object) (eq (car object) 'mock-timer)))

(ert-deftest jabber-test-system-sleep-pre-sleep-is-inert ()
  "A pre-sleep event does not mutate transport or keepalive state."
  (let* ((entry '(connection . transport))
         (timeout '(mock-timer timeout))
         (jabber-connections '(connection))
         (jabber-keepalive-round 4)
         (jabber-keepalive-pending (list entry))
         (jabber-keepalive-timeout-timer timeout)
         cancelled sent result)
    (cl-letf (((symbol-function 'sleep-event-state)
               (lambda (_) 'pre-sleep))
              ((symbol-function 'cancel-timer)
               (lambda (&rest _) (setq cancelled t)))
              ((symbol-function 'fsm-send-sync)
               (lambda (&rest args) (setq sent args))))
      (setq result
            (condition-case nil
                (progn (jabber-keepalive--system-sleep-event 'event) 'ok)
              (void-function 'missing))))
    (should (eq result 'ok))
    (should (= jabber-keepalive-round 4))
    (should (equal jabber-keepalive-pending (list entry)))
    (should (eq jabber-keepalive-timeout-timer timeout))
    (should-not cancelled)
    (should-not sent)))

(ert-deftest jabber-test-system-sleep-post-wake-invalidates-snapshot ()
  "Post-wake retires one round and contains stale per-peer failures."
  (let* ((first (make-symbol "first"))
         (second (make-symbol "second"))
         (connecting (make-symbol "connecting"))
         (first-transport (make-symbol "first-transport"))
         (second-transport (make-symbol "second-transport"))
         (successor (make-symbol "successor"))
         (timeout '(mock-timer timeout))
         (recurring '(mock-timer recurring))
         (jabber-connections (list first second connecting))
         (jabber-keepalive-timer recurring)
         (jabber-keepalive-timeout-timer timeout)
         (jabber-keepalive-pending '((old . transport)))
         (jabber-keepalive-round 9)
         cancelled events second-result result)
    (put first :state :session-established)
    (put first :state-data (list :connection first-transport))
    (put second :state :session-established)
    (put second :state-data (list :connection second-transport))
    (put connecting :state :connecting)
    (put connecting :state-data '(:connection nil))
    (cl-letf (((symbol-function 'sleep-event-state)
               (lambda (_) 'post-wake))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p)
              ((symbol-function 'cancel-timer)
               (lambda (timer) (push timer cancelled)))
              ((symbol-function 'fsm-send-sync)
               (lambda (jc event)
                 (push (cons jc event) events)
                 (if (eq jc first)
                     (progn
                       (put second :state-data (list :connection successor))
                       (error "first failed"))
                   (setq second-result
                         (funcall
                          (gethash :session-established
                                   (get 'jabber-connection :fsm-event))
                          jc (fsm-get-state-data jc) event #'ignore))))))
      (setq result
            (condition-case nil
                (progn (jabber-keepalive--system-sleep-event 'event) 'ok)
              (void-function 'missing))))
    (setq events (nreverse events))
    (should (eq result 'ok))
    (should (= jabber-keepalive-round 10))
    (should-not jabber-keepalive-pending)
    (should-not jabber-keepalive-timeout-timer)
    (should (eq jabber-keepalive-timer recurring))
    (should (equal cancelled (list timeout)))
    (should (equal (mapcar #'car events) (list first second)))
    (should (equal (cdr (assq first events))
                   (list :connection-dead first-transport "System wake")))
    (should (equal (cdr (assq second events))
                   (list :connection-dead second-transport "System wake")))
    (should (eq (car second-result) :session-established))
    (should (eq (plist-get (cadr second-result) :connection) successor))))

(ert-deftest jabber-test-system-sleep-handler-contains-event-errors ()
  "A malformed sleep event cannot stop the abnormal hook chain."
  (let (result)
    (cl-letf (((symbol-function 'sleep-event-state)
               (lambda (_) (error "bad event"))))
      (setq result
            (condition-case nil
                (progn (jabber-keepalive--system-sleep-event 'event) 'ok)
              (error 'escaped))))
    (should (eq result 'ok))))

(ert-deftest jabber-test-system-sleep-registration-is-optional ()
  "Sleep support registers idempotently and absence remains inert."
  (let ((was-loaded (featurep 'system-sleep))
        (hooks-bound (boundp 'system-sleep-event-functions))
        (saved-hooks (and (boundp 'system-sleep-event-functions)
                          (symbol-value 'system-sleep-event-functions)))
        (enabled 0))
    (set 'system-sleep-event-functions nil)
    (unless was-loaded
      (provide 'system-sleep))
    (unwind-protect
        (progn
          (cl-letf (((symbol-function 'system-sleep-enable)
                     (lambda () (cl-incf enabled))))
            (jabber-keepalive--enable-system-sleep nil)
            (jabber-keepalive--enable-system-sleep nil))
          (should (= enabled 2))
          (should (equal (symbol-value 'system-sleep-event-functions)
                         '(jabber-keepalive--system-sleep-event))))
      (unless was-loaded
        (setq features (delq 'system-sleep features)))
      (if hooks-bound
          (set 'system-sleep-event-functions saved-hooks)
        (makunbound 'system-sleep-event-functions))))
  (let ((was-loaded (featurep 'system-sleep))
        (hooks-bound (boundp 'system-sleep-event-functions))
        (saved-hooks (and (boundp 'system-sleep-event-functions)
                          (symbol-value 'system-sleep-event-functions)))
        (load-path nil)
        called)
    (set 'system-sleep-event-functions '(existing))
    (unwind-protect
        (progn
          (setq features (delq 'system-sleep features))
          (cl-letf (((symbol-function 'system-sleep-enable)
                     (lambda () (setq called t))))
            (jabber-keepalive--enable-system-sleep nil))
          (should (equal (symbol-value 'system-sleep-event-functions)
                         '(existing)))
          (should-not called))
      (when was-loaded
        (provide 'system-sleep))
      (if hooks-bound
          (set 'system-sleep-event-functions saved-hooks)
        (makunbound 'system-sleep-event-functions)))))

(ert-deftest jabber-test-system-sleep-registration-is-automatic ()
  "Session bootstrap owns sleep-event registration."
  (should (memq #'jabber-keepalive--enable-system-sleep
                jabber-lifecycle-session-bootstrap-functions)))

(ert-deftest jabber-test-keepalive-monitors-only-active-transports ()
  "A keepalive round snapshots only established exact transports."
  (let* ((active (make-symbol "active"))
         (reconnecting (make-symbol "reconnecting"))
         (transport (make-symbol "transport"))
         (jabber-connections (list reconnecting active))
         (jabber-keepalive-timeout-timer nil)
         (jabber-keepalive-pending nil)
         (jabber-keepalive-round 0)
         pings)
    (put active :state :session-established)
    (put active :state-data (list :connection transport))
    (put reconnecting :state :connecting)
    (put reconnecting :state-data '(:connection nil))
    (cl-letf (((symbol-function 'run-with-timer)
               (lambda (&rest _) '(mock-timer timeout)))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p)
              ((symbol-function 'jabber-ping-send)
               (lambda (jc &rest args) (push (cons jc args) pings))))
      (jabber-keepalive-do))
    (should (equal (mapcar #'car pings) (list active)))
    (should (equal jabber-keepalive-pending
                   (list (cons active transport))))))

(ert-deftest jabber-test-keepalive-timeout-reconnects-current-transport ()
  "A current keepalive timeout remains an unexpected reconnectable loss."
  (let* ((jc (make-symbol "keepalive-timeout"))
         (transport (make-symbol "transport"))
         (jabber-connections (list jc))
         (jabber-auto-reconnect t)
         (jabber-reconnect-delay 5)
         (jabber-lost-connection-hooks nil)
         (jabber-lifecycle-session-reset-functions nil)
         (jabber-keepalive-round 7)
         (jabber-keepalive-timeout-timer nil)
         (jabber-keepalive-pending (list (cons jc transport))))
    (put jc :name 'jabber-connection)
    (put jc :state :session-established)
    (put jc :state-data
         (list :username "romeo" :server "example.org" :resource "emacs"
               :connection transport :ever-session-established t))
    (put jc :deferred nil)
    (jabber-keepalive-timeout 7)
    (unwind-protect
        (progn
          (should-not (get jc :state))
          (should-not (plist-get (fsm-get-state-data jc)
                                 :disconnection-expected))
          (should (timerp (get jc :timeout)))
          (should (memq jc jabber-connections)))
      (when (timerp (get jc :timeout))
        (cancel-timer (get jc :timeout))))))

(ert-deftest jabber-test-keepalive-stale-timeout-ignores-successor ()
  "A prior round and transport cannot retire a successor connection."
  (let* ((jc (make-symbol "keepalive-successor"))
         (old-transport (make-symbol "old-transport"))
         (new-transport (make-symbol "new-transport"))
         (jabber-connections (list jc))
         (jabber-keepalive-round 8)
         (jabber-keepalive-timeout-timer '(mock-timer timeout))
         (jabber-keepalive-pending (list (cons jc old-transport)))
         sent)
    (put jc :state :session-established)
    (put jc :state-data (list :connection new-transport))
    (cl-letf (((symbol-function 'fsm-send-sync)
               (lambda (&rest args) (setq sent args)))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p)
              ((symbol-function 'cancel-timer) #'ignore))
      (jabber-keepalive-timeout 7))
    (should-not sent)
    (should (eq (plist-get (fsm-get-state-data jc) :connection)
                new-transport))))

(ert-deftest jabber-test-keepalive-stale-response-does-not-settle-round ()
  "Responses from old rounds or transports do not settle the current round."
  (let* ((jc (make-symbol "keepalive-current"))
         (old-transport (make-symbol "old-transport"))
         (transport (make-symbol "transport"))
         (entry (cons jc transport))
         (jabber-keepalive-round 8)
         (jabber-keepalive-pending (list entry))
         (jabber-keepalive-timeout-timer '(mock-timer timeout))
         cancelled)
    (put jc :state-data '(:server "example.org"))
    (cl-letf (((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p)
              ((symbol-function 'cancel-timer)
               (lambda (&rest _) (setq cancelled t))))
      (jabber-keepalive-got-response jc nil (cons 7 transport))
      (jabber-keepalive-got-response jc nil (cons 8 old-transport)))
    (should (equal jabber-keepalive-pending (list entry)))
    (should-not cancelled)))

(ert-deftest jabber-test-keepalive-send-failure-isolated-per-transport ()
  "A synchronous ping failure retires only its exact transport."
  (let* ((failed (make-symbol "failed"))
         (healthy (make-symbol "healthy"))
         (failed-transport (make-symbol "failed-transport"))
         (healthy-transport (make-symbol "healthy-transport"))
         (jabber-connections (list failed healthy))
         (jabber-keepalive-timeout-timer nil)
         (jabber-keepalive-pending nil)
         (jabber-keepalive-round 0)
         pings losses)
    (dolist (jc jabber-connections)
      (put jc :state :session-established))
    (put failed :state-data (list :connection failed-transport))
    (put healthy :state-data (list :connection healthy-transport))
    (cl-letf (((symbol-function 'run-with-timer)
               (lambda (&rest _) '(mock-timer timeout)))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p)
              ((symbol-function 'jabber-ping-send)
               (lambda (jc &rest _)
                 (if (eq jc failed)
                     (error "send failed")
                   (push jc pings))))
              ((symbol-function 'fsm-send)
               (lambda (jc event) (push (cons jc event) losses))))
      (jabber-keepalive-do))
    (should (equal pings (list healthy)))
    (should (equal jabber-keepalive-pending
                   (list (cons healthy healthy-transport))))
    (should (equal losses
                   (list (cons failed
                               (list :connection-dead failed-transport
                                     "Keepalive send failed")))))
    (should (equal jabber-keepalive-timeout-timer
                   '(mock-timer timeout)))))

(ert-deftest jabber-test-keepalive-normal-round-uses-ping-contract ()
  "A normal round calls the five-argument ping API without reporting loss."
  (let* ((jc (make-symbol "active"))
         (transport (make-symbol "transport"))
         (jabber-connections (list jc))
         (jabber-keepalive-timeout-timer nil)
         (jabber-keepalive-pending nil)
         (jabber-keepalive-round 0)
         call loss)
    (put jc :state :session-established)
    (put jc :state-data (list :connection transport))
    (cl-letf (((symbol-function 'run-with-timer)
               (lambda (&rest _) '(mock-timer timeout)))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p)
              ((symbol-function 'jabber-ping-send)
               (lambda (connection to callback success-data error-data)
                 (setq call (list connection to callback
                                  success-data error-data))))
              ((symbol-function 'fsm-send)
               (lambda (&rest args) (setq loss args))))
      (jabber-keepalive-do))
    (should (equal call
                   (list jc nil #'jabber-keepalive-got-response
                         (cons jabber-keepalive-round transport)
                         (cons jabber-keepalive-round transport))))
    (should (equal jabber-keepalive-pending (list (cons jc transport))))
    (should-not loss)))

(ert-deftest jabber-test-whitespace-failure-carries-exact-transport ()
  "Whitespace send failure reports the exact transport that failed."
  (let* ((jc (make-symbol "whitespace-failure"))
         (transport (make-symbol "transport"))
         (jabber-connections (list jc))
         sent)
    (put jc :state :session-established)
    (put jc :state-data (list :connection transport))
    (cl-letf (((symbol-function 'process-live-p) (lambda (_) t))
              ((symbol-function 'jabber-send-string)
               (lambda (&rest _) (error "send failed")))
              ((symbol-function 'fsm-send)
               (lambda (_jc event) (setq sent event))))
      (jabber-whitespace-ping-do))
    (should (equal sent
                   (list :connection-dead transport
                         "Whitespace ping failed")))))

(ert-deftest jabber-test-keepalive-do-replaces-timeout-timer ()
  "Rearming keepalive cancels the previous timeout timer."
  (let* ((first (make-symbol "first"))
         (second (make-symbol "second"))
         (jabber-connections (list first second))
         (jabber-keepalive-timeout-timer nil)
         (jabber-keepalive-pending nil)
         (live-timers nil)
         (cancelled-timers nil)
         (next-timer-id 0))
    (dolist (jc jabber-connections)
      (put jc :state :session-established)
      (put jc :state-data (list :connection jc)))
    (cl-letf (((symbol-function 'run-with-timer)
               (lambda (&rest _args)
                 (let ((timer (list 'mock-timer (cl-incf next-timer-id))))
                   (push timer live-timers)
                   timer)))
              ((symbol-function 'cancel-timer)
               (lambda (timer)
                 (setq live-timers (delq timer live-timers))
                 (push timer cancelled-timers)))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p)
              ((symbol-function 'jabber-ping-send) #'ignore))
      (jabber-keepalive-do)
      (let ((first-timer jabber-keepalive-timeout-timer))
        (jabber-keepalive-do)
        (should (equal cancelled-timers (list first-timer)))
        (should (= (length live-timers) 1))
        (should (eq (car live-timers) jabber-keepalive-timeout-timer))
        (should-not (eq first-timer jabber-keepalive-timeout-timer))))))

(ert-deftest jabber-test-keepalive-start-clears-previous-round ()
  "Restarting keepalive clears timers and pending state from the old round."
  (let* ((recurring-timer (list 'mock-timer 'recurring))
         (timeout-timer (list 'mock-timer 'timeout))
         (replacement-timer (list 'mock-timer 'replacement))
         (jabber-keepalive-timer recurring-timer)
         (jabber-keepalive-timeout-timer timeout-timer)
         (jabber-keepalive-pending '(stale))
         (jabber-post-disconnect-hook nil)
         (cancelled-timers nil))
    (cl-letf (((symbol-function 'run-with-timer)
               (lambda (&rest _args) replacement-timer))
              ((symbol-function 'cancel-timer)
               (lambda (timer) (push timer cancelled-timers)))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p))
      (jabber-keepalive-start)
      (should (eq jabber-keepalive-timer replacement-timer))
      (should (null jabber-keepalive-timeout-timer))
      (should (null jabber-keepalive-pending))
      (should (equal cancelled-timers
                     (list timeout-timer recurring-timer))))))

(ert-deftest jabber-test-keepalive-start-clears-timeout-without-recurring-timer ()
  "Restarting keepalive clears a stale round without a recurring timer."
  (let* ((timeout-timer (list 'mock-timer 'timeout))
         (replacement-timer (list 'mock-timer 'replacement))
         (jabber-keepalive-timer nil)
         (jabber-keepalive-timeout-timer timeout-timer)
         (jabber-keepalive-pending '(stale))
         (jabber-post-disconnect-hook nil)
         (cancelled-timers nil))
    (cl-letf (((symbol-function 'run-with-timer)
               (lambda (&rest _args) replacement-timer))
              ((symbol-function 'cancel-timer)
               (lambda (timer) (push timer cancelled-timers)))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p))
      (jabber-keepalive-start)
      (should (eq jabber-keepalive-timer replacement-timer))
      (should (null jabber-keepalive-timeout-timer))
      (should (null jabber-keepalive-pending))
      (should (equal cancelled-timers (list timeout-timer))))))

(ert-deftest jabber-test-keepalive-timeout-preserves-survivor-monitoring ()
  "Timing out one connection keeps monitoring the surviving connection."
  (let* ((survivor (make-symbol "survivor"))
         (lost (make-symbol "lost"))
         (survivor-transport (make-symbol "survivor-transport"))
         (lost-transport (make-symbol "lost-transport"))
         (recurring-timer (list 'mock-timer 'recurring))
         (jabber-connections (list survivor lost))
         (jabber-keepalive-timer recurring-timer)
         (jabber-keepalive-timeout-timer nil)
         (jabber-keepalive-pending nil)
         (jabber-keepalive-round 0)
         (live-timers (list recurring-timer))
         (cancelled-timers nil)
         (losses nil)
         (pings nil)
         (next-timer-id 0))
    (put survivor :state :session-established)
    (put survivor :state-data
         (list :server "survivor" :connection survivor-transport))
    (put lost :state :session-established)
    (put lost :state-data (list :server "lost" :connection lost-transport))
    (cl-letf (((symbol-function 'run-with-timer)
               (lambda (&rest _args)
                 (let ((timer (list 'mock-timer (cl-incf next-timer-id))))
                   (push timer live-timers)
                   timer)))
              ((symbol-function 'cancel-timer)
               (lambda (timer)
                 (setq live-timers (delq timer live-timers))
                 (push timer cancelled-timers)))
              ((symbol-function 'timerp)
               #'jabber-test-keepalive--mock-timer-p)
              ((symbol-function 'jabber-ping-send)
               (lambda (jc &rest _args) (push jc pings)))
              ((symbol-function 'fsm-send-sync)
               (lambda (jc event)
                 (push (cons jc event) losses)
                 (setq jabber-connections (delq jc jabber-connections)))))
      (jabber-keepalive-do)
      (jabber-keepalive-got-response
       survivor nil (cons jabber-keepalive-round survivor-transport))
      (setq pings nil)
      (jabber-keepalive-timeout jabber-keepalive-round)
      (should (eq jabber-keepalive-timer recurring-timer))
      (should (memq recurring-timer live-timers))
      (should-not (memq recurring-timer cancelled-timers))
      (should (null jabber-keepalive-timeout-timer))
      (should (null jabber-keepalive-pending))
      (should (equal losses
                     (list (cons lost
                                 (list :connection-dead lost-transport
                                       "Keepalive timeout")))))
      (should (equal jabber-connections (list survivor)))
      (jabber-keepalive-do)
      (should (equal pings (list survivor))))))

(ert-deftest jabber-test-keepalive-timeout-stops-without-connections ()
  "Timing out the final connection stops the recurring timer."
  (let* ((lost (make-symbol "lost"))
         (transport (make-symbol "transport"))
         (recurring-timer (list 'mock-timer 'recurring))
         (jabber-connections (list lost))
         (jabber-keepalive-timer recurring-timer)
         (jabber-keepalive-timeout-timer (list 'mock-timer 'timeout))
         (jabber-keepalive-pending (list (cons lost transport)))
         (jabber-keepalive-round 3)
         (cancelled-timers nil)
         loss)
    (put lost :state-data (list :server "lost" :connection transport))
    (cl-letf (((symbol-function 'cancel-timer)
               (lambda (timer) (push timer cancelled-timers)))
              ((symbol-function 'fsm-send-sync)
               (lambda (jc event)
                 (setq loss (cons jc event))
                 (setq jabber-connections (delq jc jabber-connections)))))
      (jabber-keepalive-timeout 3)
      (should (null jabber-connections))
      (should (null jabber-keepalive-timer))
      (should (null jabber-keepalive-timeout-timer))
      (should (null jabber-keepalive-pending))
      (should (equal loss
                     (cons lost (list :connection-dead transport
                                      "Keepalive timeout"))))
      (should (equal cancelled-timers (list recurring-timer))))))

(ert-deftest jabber-test-keepalive-default-session-hooks ()
  "Default fresh and resumed sessions enable response-checked liveness."
  (dolist (hook '(jabber-post-connect-hooks jabber-post-resume-hooks))
    (should (memq #'jabber-keepalive-start (default-value hook)))))

(provide 'jabber-test-keepalive)

;;; jabber-test-keepalive.el ends here
