;;; erc-d-tests.el --- tests for erc-d -*- lexical-binding: t -*-

;; Copyright (C) 2020-2025 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Code:

(require 'ert-x)
(eval-and-compile
  (let ((load-path (cons (expand-file-name ".." (ert-resource-directory))
                         load-path)))
    (require 'erc-d)
    (require 'erc-d-t)))

(require 'erc)

;; Temporary kludge to silence warning
(put 'erc-parse-tags 'erc-v3-warned-p t)

(ert-deftest erc-d-u--canned-load-dialog--basic ()
  (should-not (get-buffer "basic.eld"))
  (should-not erc-d-u--canned-buffers)
  (let* ((exes (erc-d-u--canned-load-dialog 'basic))
         (reap (lambda ()
                 (cl-loop with e = (erc-d-u--read-dialog exes)
                          for s = (erc-d-u--read-exchange e)
                          while s collect s))))
    (should (get-buffer "basic.eld"))
    (should (memq (get-buffer "basic.eld") erc-d-u--canned-buffers))
    (should (equal (funcall reap) '((pass 10.0 "PASS " (? ?:) "changeme"))))
    (should (equal (funcall reap) '((nick 0.2 "NICK tester"))))
    (let ((r (funcall reap)))
      (should (equal (car r) '(user 0.2 "USER user 0 * :tester")))
      (should (equal
               (car (last r))
               '(0 ":irc.example.org 422 tester :MOTD File is missing"))))
    (should (equal (car (funcall reap)) '(mode-user 5 "MODE tester +i")))
    (should (equal (funcall reap)
                   '((mode-chan 1.2 "MODE #chan")
                     (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))))
    ;; See `define-error' site for `iter-end-of-sequence'
    (ert-info ("EOB detected") (should-not (erc-d-u--read-dialog exes))))
  (should-not (get-buffer "basic.eld"))
  (should-not erc-d-u--canned-buffers))

(defun erc-d-tests--make-hunk-reader (hunks)
  (let ((p (erc-d-u--read-dialog hunks)))
    (lambda () (erc-d-u--read-exchange p))))

;; Fuzzies need to be able to access any non-exhausted genny.
(ert-deftest erc-d-u--canned-load-dialog--intermingled ()
  (should-not (get-buffer "basic.eld"))
  (should-not erc-d-u--canned-buffers)
  (let* ((exes (erc-d-u--canned-load-dialog 'basic))
         (pass (erc-d-tests--make-hunk-reader exes))
         (nick (erc-d-tests--make-hunk-reader exes))
         (user (erc-d-tests--make-hunk-reader exes))
         (modu (erc-d-tests--make-hunk-reader exes))
         (modc (erc-d-tests--make-hunk-reader exes)))

    (should (equal (funcall user) '(user 0.2 "USER user 0 * :tester")))
    (should (equal (funcall modu) '(mode-user 5 "MODE tester +i")))
    (should (equal (funcall modc) '(mode-chan 1.2 "MODE #chan")))

    (cl-loop repeat 8 do (funcall user)) ; skip a few
    (should (equal (funcall user)
                   '(0 ":irc.example.org 254 tester 1 :channels formed")))
    (should (equal (funcall modu)
                   '(0 ":irc.example.org 221 tester +Zi")))
    (should (equal (cl-loop for s = (funcall modc) while s collect s) ; done
                   '((0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))))

    (cl-loop repeat 3 do (funcall user))
    (cl-loop repeat 3 do (funcall modu))

    (ert-info ("Change up the order")
      (should
       (equal (funcall modu)
              '(0 ":irc.example.org 366 alice #chan :End of NAMES list")))
      (should
       (equal (funcall user)
              '(0 ":irc.example.org 422 tester :MOTD File is missing"))))

    ;; Exhaust these
    (should (equal (cl-loop for s = (funcall pass) while s collect s) ; done
                   '((pass 10.0 "PASS " (? ?:) "changeme"))))
    (should (equal (cl-loop for s = (funcall nick) while s collect s) ; done
                   '((nick 0.2 "NICK tester"))))

    (ert-info ("End of file but no teardown because hunks outstanding")
      (should-not (erc-d-u--read-dialog exes))
      (should (get-buffer "basic.eld")))

    ;; Finish
    (should-not (funcall user))
    (should-not (funcall modu)))

  (should-not (get-buffer "basic.eld"))
  (should-not erc-d-u--canned-buffers))

;; This indirectly tests `erc-d-u--canned-read' cleanup/teardown

(ert-deftest erc-d-u--rewrite-for-slow-mo ()
  (should-not (get-buffer "basic.eld"))
  (should-not (get-buffer "basic.eld<2>"))
  (should-not (get-buffer "basic.eld<3>"))
  (should-not erc-d-u--canned-buffers)
  (let ((exes (erc-d-u--canned-load-dialog 'basic))
        (exes-lower (erc-d-u--canned-load-dialog 'basic))
        (exes-custom (erc-d-u--canned-load-dialog 'basic))
        (reap (lambda (e) (cl-loop with p = (erc-d-u--read-dialog e)
                                   for s = (erc-d-u--read-exchange p)
                                   while s collect s))))
    (should (get-buffer "basic.eld"))
    (should (get-buffer "basic.eld<2>"))
    (should (get-buffer "basic.eld<3>"))
    (should (equal (list (get-buffer "basic.eld<3>")
                         (get-buffer "basic.eld<2>")
                         (get-buffer "basic.eld"))
                   erc-d-u--canned-buffers))

    (ert-info ("Rewrite for slowmo basic")
      (setq exes (erc-d-u--rewrite-for-slow-mo 10 exes))
      (should (equal (funcall reap exes)
                     '((pass 20.0 "PASS " (? ?:) "changeme"))))
      (should (equal (funcall reap exes)
                     '((nick 10.2 "NICK tester"))))
      (let ((r (funcall reap exes)))
        (should (equal (car r) '(user 10.2 "USER user 0 * :tester")))
        (should (equal
                 (car (last r))
                 '(0 ":irc.example.org 422 tester :MOTD File is missing"))))
      (should (equal (car (funcall reap exes))
                     '(mode-user 15 "MODE tester +i")))
      (should (equal (car (funcall reap exes))
                     '(mode-chan 11.2 "MODE #chan")))
      (should-not (erc-d-u--read-dialog exes)))

    (ert-info ("Rewrite for slowmo bounded")
      (setq exes-lower (erc-d-u--rewrite-for-slow-mo -5 exes-lower))
      (should (equal (funcall reap exes-lower)
                     '((pass 10.0 "PASS " (? ?:) "changeme"))))
      (should (equal (funcall reap exes-lower)
                     '((nick 5 "NICK tester"))))
      (should (equal (car (funcall reap exes-lower))
                     '(user 5 "USER user 0 * :tester")))
      (should (equal (car (funcall reap exes-lower))
                     '(mode-user 5 "MODE tester +i")))
      (should (equal (car (funcall reap exes-lower))
                     '(mode-chan 5 "MODE #chan")))
      (should-not (erc-d-u--read-dialog exes-lower)))

    (ert-info ("Rewrite for slowmo custom")
      (setq exes-custom (erc-d-u--rewrite-for-slow-mo
                         (lambda (n) (* 2 n)) exes-custom))
      (should (equal (funcall reap exes-custom)
                     '((pass 20.0 "PASS " (? ?:) "changeme"))))
      (should (equal (funcall reap exes-custom)
                     '((nick 0.4 "NICK tester"))))
      (should (equal (car (funcall reap exes-custom))
                     '(user 0.4 "USER user 0 * :tester")))
      (should (equal (car (funcall reap exes-custom))
                     '(mode-user 10 "MODE tester +i")))
      (should (equal (car (funcall reap exes-custom))
                     '(mode-chan 2.4 "MODE #chan")))
      (should-not (erc-d-u--read-dialog exes-custom))))

  (should-not (get-buffer "basic.eld"))
  (should-not (get-buffer "basic.eld<2>"))
  (should-not (get-buffer "basic.eld<3>"))
  (should-not erc-d-u--canned-buffers))

(ert-deftest erc-d--active-ex-p ()
  (let ((ring (make-ring 5)))
    (ert-info ("Empty ring returns nil for not active")
      (should-not (erc-d--active-ex-p ring)))
    (ert-info ("One fuzzy member returns nil for not active")
      (ring-insert ring (make-erc-d-exchange :tag '~foo))
      (should-not (erc-d--active-ex-p ring)))
    (ert-info ("One active member returns t for active")
      (ring-insert-at-beginning ring (make-erc-d-exchange :tag 'bar))
      (should (erc-d--active-ex-p ring)))))

(defun erc-d-tests--parse-message-upstream (raw)
  "Hack shim for parsing RAW line recvd from peer."
  (cl-letf (((symbol-function #'erc-handle-parsed-server-response)
             (lambda (_ p) p)))
    (let ((erc-active-buffer nil))
      (erc-parse-server-response nil raw))))

(ert-deftest erc-d-i--validate-tags ()
  (should (erc-d-i--validate-tags
           (concat "batch=4cc99692bf24a4bec4aa03da437364f5;"
                   "time=2021-01-04T00:32:13.839Z")))
  (should (erc-d-i--validate-tags "+foo=bar;baz=spam"))
  (should (erc-d-i--validate-tags "foo=\\:ok;baz=\\s"))
  (should (erc-d-i--validate-tags "foo=\303\247edilla"))
  (should (erc-d-i--validate-tags "foo=\\"))
  (should (erc-d-i--validate-tags "foo=bar\\baz"))
  (should-error (erc-d-i--validate-tags "foo=\\\\;baz=\\\r\\\n"))
  (should-error (erc-d-i--validate-tags "foo=\n"))
  (should-error (erc-d-i--validate-tags "foo=\0ok"))
  (should-error (erc-d-i--validate-tags "foo=bar baz"))
  (should-error (erc-d-i--validate-tags "foo=bar\r"))
  (should-error (erc-d-i--validate-tags "foo=bar;")))

(ert-deftest erc-d-i--parse-message ()
  (let* ((raw (concat "@time=2020-11-23T09:10:33.088Z "
                      ":tilde.chat BATCH +1 chathistory :#meta"))
         (upstream (erc-d-tests--parse-message-upstream raw))
         (ours (erc-d-i--parse-message raw)))

    (ert-info ("Baseline upstream")
      (should (equal (erc-response.unparsed upstream) raw))
      (should (equal (erc-response.sender upstream) "tilde.chat"))
      (should (equal (erc-response.command upstream) "BATCH"))
      (should (equal (erc-response.command-args upstream)
                     '("+1" "chathistory" "#meta")))
      (should (equal (erc-response.contents upstream) "#meta")))

    (ert-info ("Ours my not compare cl-equalp but is otherwise the same")
      (should (equal (erc-d-i-message.unparsed ours) raw))
      (should (equal (erc-d-i-message.sender ours) "tilde.chat"))
      (should (equal (erc-d-i-message.command ours) "BATCH"))
      (should (equal (erc-d-i-message.command-args ours)
                     '("+1" "chathistory" "#meta")))
      (should (equal (erc-d-i-message.contents ours) "#meta"))
      (should (equal (erc-d-i-message.tags ours)
                     '((time . "2020-11-23T09:10:33.088Z")))))

    (ert-info ("No compat decodes the whole message as utf-8")
      (setq ours (erc-d-i--parse-message
                  "@foo=\303\247edilla TAGMSG #ch\303\240n"
                  'decode))
      (should-not (erc-d-i-message.compat ours))
      (should (equal (erc-d-i-message.command-args ours) '("#chàn")))
      (should (equal (erc-d-i-message.contents ours) ""))
      (should (equal (erc-d-i-message.tags ours) '((foo . "çedilla")))))))

(ert-deftest erc-d-i--unescape-tag-value ()
  (should (equal (erc-d-i--unescape-tag-value
                  "\\sabc\\sdef\\s\\sxyz\\s")
                 " abc def  xyz "))
  (should (equal (erc-d-i--unescape-tag-value
                  "\\\\abc\\\\def\\\\\\\\xyz\\\\")
                 "\\abc\\def\\\\xyz\\"))
  (should (equal (erc-d-i--unescape-tag-value "a\\bc") "abc"))
  (should (equal (erc-d-i--unescape-tag-value
                  "\\\\abc\\\\def\\\\\\\\xyz\\")
                 "\\abc\\def\\\\xyz"))
  (should (equal (erc-d-i--unescape-tag-value "a\\:b\\r\\nc\\sd")
                 "a;b\r\nc d")))

(ert-deftest erc-d-i--escape-tag-value ()
  (should (equal (erc-d-i--escape-tag-value " abc def  xyz ")
                 "\\sabc\\sdef\\s\\sxyz\\s"))
  (should (equal (erc-d-i--escape-tag-value "\\abc\\def\\\\xyz\\")
                 "\\\\abc\\\\def\\\\\\\\xyz\\\\"))
  (should (equal (erc-d-i--escape-tag-value "a;b\r\nc d")
                 "a\\:b\\r\\nc\\sd")))

;; TODO add tests for msg-join, mask-match, userhost-split,
;; validate-hostname

(ert-deftest erc-d-i--parse-message--irc-parser-tests ()
  (let* ((data (with-temp-buffer
                 (insert-file-contents
                  (expand-file-name "irc-parser-tests.eld"
                                    (ert-resource-directory)))
                 (read (current-buffer))))
         (tests (assoc-default 'tests (assoc-default 'msg-split data)))
         input atoms m ours)
    (dolist (test tests)
      (setq input (assoc-default 'input test)
            atoms (assoc-default 'atoms test)
            m (erc-d-i--parse-message input))
      (ert-info ("Parses tags correctly")
        (setq ours (erc-d-i-message.tags m))
        (if-let ((tags (assoc-default 'tags atoms)))
            (pcase-dolist (`(,key . ,value) ours)
              (should (string= (cdr (assq key tags)) (or value ""))))
          (should-not ours)))
      (ert-info ("Parses verbs correctly")
        (setq ours (erc-d-i-message.command m))
        (if-let ((verbs (assoc-default 'verb atoms)))
            (should (string= (downcase verbs) (downcase ours)))
          (should (string-empty-p ours))))
      (ert-info ("Parses sources correctly")
        (setq ours (erc-d-i-message.sender m))
        (if-let ((source (assoc-default 'source atoms)))
            (should (string= source ours))
          (should (string-empty-p ours))))
      (ert-info ("Parses params correctly")
        (setq ours (erc-d-i-message.command-args m))
        (if-let ((params (assoc-default 'params atoms)))
            (should (equal ours params))
          (should-not ours))))))

(defun erc-d-tests--new-ex (existing raw-hunk)
  (let* ((f (lambda (_) (pop raw-hunk)))
         (sd (make-erc-d-u-scan-d :f f)))
    (setf (erc-d-exchange-hunk existing) (make-erc-d-u-scan-e :sd sd)
          (erc-d-exchange-spec existing) (make-erc-d-spec)))
  (erc-d--iter existing))

(ert-deftest erc-d--render-entries ()
  (let* ((erc-nick "foo")
         (dialog (make-erc-d-dialog :vars `((:a . 1)
                                            (c . ((a b) (: a space b)))
                                            (d . (c alpha digit))
                                            (bee . 2)
                                            (f . ,(lambda () "3"))
                                            (i . erc-nick))))
         (exchange (make-erc-d-exchange :dialog dialog))
         (mex (apply-partially #'erc-d-tests--new-ex exchange))
         it)

    (erc-d-exchange-reload dialog exchange)

    (ert-info ("Baseline Outgoing")
      (setq it (funcall mex '((0 "abc"))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "abc")))

    (ert-info ("Incoming are regexp escaped")
      (setq it (funcall mex '((i 0.0 "fsf" ".org"))))
      (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
      (should (equal (funcall it) "\\`fsf\\.org")))

    (ert-info ("Incoming can access vars via rx-let")
      (setq it (funcall mex '((i 0.0 bee))))
      (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
      (should (equal (funcall it) "\\`\002")))

    (ert-info ("Incoming rx-let params")
      (setq it (funcall mex '((i 0.0 d))))
      (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
      (should (equal (funcall it) "\\`[[:alpha:]][[:space:]][[:digit:]]")))

    (ert-info ("Incoming literal rx forms")
      (setq it (funcall mex '((i 0.0 (= 3 alpha) ".org"))))
      (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
      (should (equal (funcall it) "\\`[[:alpha:]]\\{3\\}\\.org")))

    (ert-info ("Self-quoting disallowed")
      (setq it (funcall mex '((0 :a "abc"))))
      (should (equal (funcall it) 0))
      (should-error (funcall it)))

    (ert-info ("Global vars and short vars")
      (setq it (funcall mex '((0 i f erc-nick))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "foo3foo")))

    (ert-info ("Exits clean")
      (should-not (funcall it))
      (should (equal (erc-d-dialog-vars dialog)
                     `((:a . 1)
                       (c . ((a b) (: a space b)))
                       (d . (c alpha digit))
                       (bee . 2)
                       (f . ,(alist-get 'f (erc-d-dialog-vars dialog)))
                       (i . erc-nick)))))))

(ert-deftest erc-d--render-entries--matches ()
  (let* ((alist (list
                 (cons 'f (lambda (a) (funcall a :match 1)))
                 (cons 'g (lambda () (match-string 2 "foo bar baz")))
                 (cons 'h (lambda (a) (concat (funcall a :match 0)
                                              (funcall a :request))))
                 (cons 'i (lambda (_ e) (erc-d-exchange-request e)))
                 (cons 'j (lambda ()
                            (set-match-data '(0 1))
                            (match-string 0 "j")))))
         (dialog (make-erc-d-dialog :vars alist))
         (exchange (make-erc-d-exchange :dialog dialog
                                        :request "foo bar baz"
                                        ;;            11  222
                                        :match-data '(4 11 4 6 8 11)))
         (mex (apply-partially #'erc-d-tests--new-ex exchange))
         it)

    (erc-d-exchange-reload dialog exchange)

    (ert-info ("One arg, match")
      (setq it (funcall mex '((0 f))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "ba")))

    (ert-info ("No args")
      (setq it (funcall mex '((0 g))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "baz")))

    (ert-info ("Second arg is exchange object")
      (setq it (funcall mex '((0 i))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "foo bar baz")))

    (ert-info ("One arg, multiple calls")
      (setq it (funcall mex '((0 h))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "bar bazfoo bar baz")))

    (ert-info ("Match data restored")
      (setq it (funcall mex '((0 j))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "j"))

      (setq it (funcall mex '((0 g))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "baz")))

    (ert-info ("Bad signature")
      (let ((qlist (list 'f '(lambda (p q x) (ignore)))))
        (setf (erc-d-dialog-vars dialog) qlist)
        (should-error (erc-d-exchange-reload dialog exchange))))))

(ert-deftest erc-d--render-entries--dynamic ()
  (let* ((alist (list
                 (cons 'foo "foo")
                 (cons 'f (lambda (a) (funcall a :get-binding 'foo)))
                 (cons 'h (lambda (a) (upcase (funcall a :get-var 'foo))))
                 (cons 'g (lambda (a)
                            (funcall a :rebind 'g (funcall a :get-var 'f))
                            "bar"))
                 (cons 'j (lambda (a) (funcall a :set "123") "abc"))
                 (cons 'k (lambda () "abc"))))
         (dialog (make-erc-d-dialog :vars alist))
         (exchange (make-erc-d-exchange :dialog dialog))
         (mex (apply-partially #'erc-d-tests--new-ex exchange))
         it)

    (erc-d-exchange-reload dialog exchange)

    (ert-info ("Initial reference calls function")
      (setq it (funcall mex '((0 j) (0 j))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "abc")))

    (ert-info ("Subsequent reference expands to string")
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "123")))

    (ert-info ("Outside manipulation: initial reference calls function")
      (setq it (funcall mex '((0 k) (0 k))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "abc")))

    (ert-info ("Outside manipulation: subsequent reference expands to string")
      (erc-d-exchange-rebind dialog exchange 'k "123")
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "123")))

    (ert-info ("Swap one function for another")
      (setq it (funcall mex '((0 g) (0 g))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "bar"))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "foo")))

    (ert-info ("Bindings accessible inside functions")
      (setq it (funcall mex '((0 f h))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "fooFOO")))

    (ert-info ("Rebuild alist by sending flag")
      (setq it (funcall mex '((0 f) (1 f) (2 f) (i 3 f))))
      (should (equal (funcall it) 0))
      (should (equal (funcall it) "foo"))
      (erc-d-exchange-rebind dialog exchange 'f "bar")
      (should (equal (funcall it) 1))
      (should (equal (funcall it) "bar"))
      (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog))
                        (lambda nil "baz")))
      (should (eq (funcall it) 2))
      (should (equal (funcall it 'reload) "baz"))
      (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog)) "spam"))
      (should (eq (funcall it) 'i))
      (should (eq (funcall it 'reload) 3))
      (should (equal (funcall it) "\\`spam")))))

(ert-deftest erc-d-t-with-cleanup ()
  (should-not (get-buffer "*echo*"))
  (should-not (get-buffer "*foo*"))
  (should-not (get-buffer "*bar*"))
  (should-not (get-buffer "*baz*"))
  (erc-d-t-with-cleanup
      ((echo (start-process "echo" (get-buffer-create "*echo*") "sleep" "1"))
       (buffer-foo (get-buffer-create "*foo*"))
       (buffer-bar (get-buffer-create "*bar*"))
       (clean-up (list (intern (process-name echo)))) ; let*
       buffer-baz)
      (ert-info ("Clean Up")
        (should (equal clean-up '(ran echo)))
        (should (bufferp buffer-baz))
        (should (bufferp buffer-foo))
        (setq buffer-foo nil))
    (setq buffer-baz (get-buffer-create "*baz*"))
    (push 'ran clean-up))
  (ert-info ("Buffers and procs destroyed")
    (should-not (get-buffer "*echo*"))
    (should-not (get-buffer "*bar*"))
    (should-not (get-buffer "*baz*")))
  (ert-info ("Buffer foo spared")
    (should (get-buffer "*foo*"))
    (kill-buffer "*foo*")))

(ert-deftest erc-d-t-wait-for ()
  :tags '(:unstable)
  (let (v)
    (run-at-time 0.2 nil (lambda () (setq v t)))
    (should (erc-d-t-wait-for 0.4 "result becomes non-nil" v))
    (should-error (erc-d-t-wait-for 0.4 "result stays nil" (not v)))
    (setq v nil)
    (should-not (erc-d-t-wait-for -0.4 "inverted stays nil" v))
    (run-at-time 0.2 nil (lambda () (setq v t)))
    (setq v nil)
    (should-error (erc-d-t-wait-for -0.4 "inverted becomes non-nil" v))))

(defvar erc-d-tests-with-server-password "changeme")

;; Compromise between removing `autojoin' from `erc-modules' entirely
;; and allowing side effects to meddle excessively
(defvar erc-autojoin-channels-alist)

;; This is only meant to be used by tests in this file.
(cl-defmacro erc-d-tests-with-server ((dumb-server-var erc-server-buffer-var)
                                      dialog &rest body)
  "Create server for DIALOG and run BODY.
DIALOG may also be a list of dialogs.  ERC-SERVER-BUFFER-VAR and
DUMB-SERVER-VAR are bound accordingly in BODY."
  (declare (indent 2))
  (when (eq '_ dumb-server-var)
    (setq dumb-server-var (make-symbol "dumb-server-var")))
  (when (eq '_ erc-server-buffer-var)
    (setq erc-server-buffer-var (make-symbol "erc-server-buffer-var")))
  (if (listp dialog)
      (setq dialog (mapcar (lambda (f) (list 'quote f)) dialog))
    (setq dialog `((quote ,dialog))))
  `(let* (auth-source-do-cache
          (,dumb-server-var (erc-d-run "localhost" t ,@dialog))
          ,erc-server-buffer-var
          ;;
          (erc-server-flood-penalty 0.05)
          erc-autojoin-channels-alist
          erc-after-connect
          erc-server-auto-reconnect)
     (should-not erc-d--slow-mo)
     (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
     ;; Allow important messages through, even in -batch mode.
     (advice-add #'erc-handle-login :around #'erc-d-t-silence-around)
     (advice-add #'erc-server-connect :around #'erc-d-t-silence-around)
     (unless (or noninteractive erc-debug-irc-protocol)
       (erc-toggle-debug-irc-protocol))
     (setq ,erc-server-buffer-var
           (erc :server "localhost"
                :password erc-d-tests-with-server-password
                :port (process-contact ,dumb-server-var :service)
                :nick "tester"
                :full-name "tester"))
     (unwind-protect
         (progn
           ,@body
           (erc-d-t-wait-for 1 "dumb-server death"
             (not (process-live-p ,dumb-server-var))))
       (when (process-live-p erc-server-process)
         (delete-process erc-server-process))
       (advice-remove #'erc-handle-login #'erc-d-t-silence-around)
       (advice-remove #'erc-server-connect #'erc-d-t-silence-around)
       (when noninteractive
         (kill-buffer ,erc-server-buffer-var)
         (erc-d-t-kill-related-buffers)))))

(defmacro erc-d-tests-with-failure-spy (found func-syms &rest body)
  "Wrap functions with advice for inspecting errors caused by BODY.
Do this for functions whose names appear in FUNC-SYMS.  When running
advice code, add errors to list FOUND.  Note: the teardown finalizer is
not added by default.  Also, `erc-d-linger-secs' likely has to be
nonzero for this to work."
  (declare (indent 2))
  ;; Catch errors thrown by timers that `should-error'ignores
  `(progn
     (let ((ad (lambda (f o &rest r)
                 (condition-case err
                     (apply o r)
                   (error (push err ,found)
                          (advice-remove f 'spy))))))
       (dolist (sym ,func-syms)
         (advice-add sym :around (apply-partially ad sym) '((name . spy)))))
     (progn ,@body)
     (dolist (sym ,func-syms)
       (advice-remove sym 'spy))
     (setq ,found (nreverse ,found))))

(ert-deftest erc-d-run-nonstandard-messages ()
  :tags '(:expensive-test)
  (let* ((erc-d-linger-secs 0.2)
         (dumb-server (erc-d-run "localhost" t 'nonstandard))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (expect (erc-d-t-make-expecter))
         client)
    (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
    (setq client (open-network-stream "erc-d-client" nil
                                      "localhost"
                                      (process-contact dumb-server :service)
                                      :coding 'binary))
    (ert-info ("Server splits CRLF delimited lines")
      (process-send-string client "ONE one\r\nTWO two\r\n")
      (with-current-buffer dumb-server-buffer
        (funcall expect 1 '(: "<- nonstandard:" (+ digit) " ONE one" eol))
        (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ TWO two$"))))
    (ert-info ("Server doesn't discard empty lines")
      (process-send-string client "\r\n")
      (with-current-buffer dumb-server-buffer
        (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ $"))))
    (ert-info ("Server preserves spaces")
      (process-send-string client " \r\n")
      (with-current-buffer dumb-server-buffer
        (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ \\{2\\}$")))
      (process-send-string client "  \r\n")
      (with-current-buffer dumb-server-buffer
        (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ \\{3\\}$"))))
    (erc-d-t-wait-for 3 "dumb-server death"
      (not (process-live-p dumb-server)))
    (delete-process client)
    (when noninteractive
      (kill-buffer dumb-server-buffer))))

(ert-deftest erc-d-run-basic ()
  :tags '(:expensive-test)
  (erc-d-tests-with-server (_ _) basic
    (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
      (erc-d-t-search-for 2 "hey"))
    (when noninteractive
      (kill-buffer "#chan"))))

(ert-deftest erc-d-run-eof ()
  :tags '(:expensive-test)
  (skip-unless noninteractive)
  (erc-d-tests-with-server (_ erc-s-buf) eof
    (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
      (erc-d-t-search-for 2 "hey"))
    (with-current-buffer erc-s-buf
      (process-send-eof erc-server-process))))

(ert-deftest erc-d-run-eof-fail ()
  :tags '(:expensive-test)
  (let (errors)
    (erc-d-tests-with-failure-spy errors '(erc-d--teardown)
      (erc-d-tests-with-server (_ _) eof
        (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
          (erc-d-t-search-for 2 "hey"))
        (erc-d-t-wait-for 10 errors)))
    (should (string-match-p "Timed out awaiting request.*__EOF__"
                            (cadr (pop errors))))))

(ert-deftest erc-d-run-linger ()
  :tags '(:unstable :expensive-test)
  (erc-d-tests-with-server (dumb-s _) linger
    (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
      (erc-d-t-search-for 2 "hey"))
    (with-current-buffer (process-buffer dumb-s)
      (erc-d-t-search-for 2 "Lingering for 1.00 seconds"))
    (with-current-buffer (process-buffer dumb-s)
      (erc-d-t-search-for 3 "Lingered for 1.00 seconds"))))

(ert-deftest erc-d-run-linger-fail ()
  :tags '(:unstable :expensive-test)
  (let ((erc-server-flood-penalty 0.1)
        errors)
    (erc-d-tests-with-failure-spy
        errors '(erc-d--teardown erc-d-command)
      (erc-d-tests-with-server (_ _) linger
        (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
          (erc-d-t-search-for 2 "hey")
          (erc-cmd-MSG "#chan hi"))
        (erc-d-t-wait-for 10 "Bad match" errors)))
    (should (string-match-p "Match failed.*hi" (cadr (pop errors))))))

(ert-deftest erc-d-run-linger-direct ()
  :tags '(:unstable :expensive-test)
  (let* ((dumb-server (erc-d-run "localhost" t
                                 'linger-multi-a 'linger-multi-b))
         (port (process-contact dumb-server :service))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer-a (get-buffer-create "*erc-d-client-a*"))
         (client-buffer-b (get-buffer-create "*erc-d-client-b*"))
         (start (current-time))
         client-a client-b)
    (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
    (setq client-a (open-network-stream "erc-d-client-a" client-buffer-a
                                        "localhost" port
                                        :coding 'binary)
          client-b (open-network-stream "erc-d-client-b" client-buffer-b
                                        "localhost" port
                                        :coding 'binary))
    (process-send-string client-a "PASS :a\r\n")
    (sleep-for 0.01)
    (process-send-string client-b "PASS :b\r\n")
    (sleep-for 0.01)
    (erc-d-t-wait-for 3 "dumb-server death"
      (not (process-live-p dumb-server)))
    (ert-info ("Ensure linger of one second")
      (should (time-less-p 1 (time-subtract (current-time) start)))
      (should (time-less-p (time-subtract (current-time) start) 1.5)))
    (delete-process client-a)
    (delete-process client-b)
    (when noninteractive
      (kill-buffer client-buffer-a)
      (kill-buffer client-buffer-b)
      (kill-buffer dumb-server-buffer))))

(ert-deftest erc-d-run-drop-direct ()
  :tags '(:unstable)
  (let* ((dumb-server (erc-d-run "localhost" t 'drop-a 'drop-b))
         (port (process-contact dumb-server :service))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer-a (get-buffer-create "*erc-d-client-a*"))
         (client-buffer-b (get-buffer-create "*erc-d-client-b*"))
         (start (current-time))
         client-a client-b)
    (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
    (setq client-a (open-network-stream "erc-d-client-a" client-buffer-a
                                        "localhost" port
                                        :coding 'binary)
          client-b (open-network-stream "erc-d-client-b" client-buffer-b
                                        "localhost" port
                                        :coding 'binary))
    (process-send-string client-a "PASS :a\r\n")
    (sleep-for 0.01)
    (process-send-string client-b "PASS :b\r\n")
    (erc-d-t-wait-for 3 "client-a dies" (not (process-live-p client-a)))
    (should (time-less-p (time-subtract (current-time) start) 0.32))
    (erc-d-t-wait-for 3 "dumb-server death"
      (not (process-live-p dumb-server)))
    (ert-info ("Ensure linger of one second")
      (should (time-less-p 1 (time-subtract (current-time) start))))
    (delete-process client-a)
    (delete-process client-b)
    (when noninteractive
      (kill-buffer client-buffer-a)
      (kill-buffer client-buffer-b)
      (kill-buffer dumb-server-buffer))))

(ert-deftest erc-d-run-no-match ()
  :tags '(:expensive-test)
  (let ((erc-d-linger-secs 1)
        erc-server-auto-reconnect
        errors)
    (erc-d-tests-with-failure-spy errors '(erc-d--teardown erc-d-command)
      (erc-d-tests-with-server (_ erc-server-buffer) no-match
        (with-current-buffer erc-server-buffer
          (erc-d-t-search-for 2 "away")
          (erc-cmd-JOIN "#foo")
          (erc-d-t-wait-for 10 "Bad match" errors))))
    (should (string-match-p "Match failed.*foo.*chan" (cadr (pop errors))))
    (should-not (get-buffer "#foo"))))

(ert-deftest erc-d-run-timeout ()
  :tags '(:expensive-test)
  (let ((erc-d-linger-secs 1)
        err errors)
    (erc-d-tests-with-failure-spy errors '(erc-d--teardown)
      (erc-d-tests-with-server (_ _) timeout
        (erc-d-t-wait-for 10 "error caught" errors)))
    (setq err (pop errors))
    (should (eq (car err) 'erc-d-timeout))
    (should (string-match-p "Timed out" (cadr err)))))

(ert-deftest erc-d-run-unexpected ()
  :tags '(:expensive-test)
  (let ((erc-d-linger-secs 2)
        errors)
    (erc-d-tests-with-failure-spy
        errors '(erc-d--teardown erc-d-command)
      (erc-d-tests-with-server (_ _) unexpected
        (ert-info ("All specs consumed when more input arrives")
          (erc-d-t-wait-for 10 "error caught" (cdr errors)))))
    (should (string-match-p "unexpected.*MODE" (cadr (pop errors))))
    ;; Nonsensical normally because func would have already exited when
    ;; first error was thrown
    (should (string-match-p "Match failed" (cadr (pop errors))))))

(ert-deftest erc-d-run-unexpected-depleted ()
  :tags '(:expensive-test)
  (let ((erc-d-linger-secs 3)
        errors)
    (erc-d-tests-with-failure-spy errors '(erc-d--teardown erc-d-command)
      (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*"))
             (dumb-server (erc-d-run "localhost" t 'depleted))
             (expect (erc-d-t-make-expecter))
             (client-buf (get-buffer-create "*erc-d-client*"))
             client-proc)
        (with-current-buffer dumb-server-buffer
          (erc-d-t-search-for 3 "Starting"))
        (setq client-proc (make-network-process
                           :buffer client-buf
                           :name "erc-d-client"
                           :family 'ipv4
                           :noquery t
                           :coding 'binary
                           :service (process-contact dumb-server :service)
                           :host "localhost"))
        (with-current-buffer dumb-server-buffer
          (funcall expect 3 "open from"))
        (process-send-string client-proc "PASS :changeme\r\n")
        (sleep-for 0.01)
        (process-send-string client-proc "NICK tester\r\n")
        (sleep-for 0.01)
        (process-send-string client-proc "USER user 0 * :tester\r\n")
        (sleep-for 0.01)
        (when (process-live-p client-proc)
          (process-send-string client-proc "BLAH :too much\r\n")
          (sleep-for 0.01))
        (with-current-buffer client-buf
          (funcall expect 3 "Welcome to the Internet"))
        (erc-d-t-wait-for 2 "dumb-server death"
          (not (process-live-p dumb-server)))
        (delete-process client-proc)
        (when noninteractive
          (kill-buffer client-buf)
          (kill-buffer dumb-server-buffer))))
    (should (string-match-p "unexpected.*BLAH" (cadr (pop errors))))
    ;; Wouldn't happen IRL
    (should (string-match-p "unexpected.*BLAH" (cadr (pop errors))))
    (should-not errors)))

(defun erc-d-tests--dynamic-match-user (_dialog exchange)
  "Shared pattern/response handler for canned dynamic DIALOG test."
  (should (string= (match-string 1 (erc-d-exchange-request exchange))
                   "tester")))

(defun erc-d-tests--run-dynamic ()
  "Perform common assertions for \"dynamic\" dialog."
  (erc-d-tests-with-server (dumb-server erc-server-buffer) dynamic
    (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
      (erc-d-t-search-for 2 "tester: hey"))
    (with-current-buffer erc-server-buffer
      (let ((expect (erc-d-t-make-expecter)))
        (funcall expect 2 "host is irc.fsf.org")
        (funcall expect 2 "modes for tester")))
    (with-current-buffer (process-buffer dumb-server)
      (erc-d-t-search-for 2 "irc.fsf.org"))
    (when noninteractive
      (kill-buffer "#chan"))))

(ert-deftest erc-d-run-dynamic-default-match ()
  :tags '(:expensive-test)
  (let* (dynamic-tally
         (erc-d-tmpl-vars '((user . "user")
                            (ignored . ((a b) (: a space b)))
                            (realname . (group (+ graph)))))
         (nick (lambda (a)
                 (push '(nick . match-user) dynamic-tally)
                 (funcall a :set (funcall a :match 1) 'export)))
         (dom (lambda (a)
                (push '(dom . match-user) dynamic-tally)
                (funcall a :set erc-d-server-fqdn)))
         (erc-d-match-handlers
          (list :user (lambda (d e)
                        (erc-d-exchange-rebind d e 'nick nick)
                        (erc-d-exchange-rebind d e 'dom dom)
                        (erc-d-tests--dynamic-match-user d e))
                :mode-user (lambda (d e)
                             (erc-d-exchange-rebind d e 'nick "tester")
                             (erc-d-exchange-rebind d e 'dom dom))))
         (erc-d-server-fqdn "irc.fsf.org"))
    (erc-d-tests--run-dynamic)
    (should (equal '((dom . match-user) (nick . match-user) (dom . match-user))
                   dynamic-tally))))

(ert-deftest erc-d-run-dynamic-default-match-rebind ()
  :tags '(:expensive-test)
  (let* (tally
         ;;
         (erc-d-tmpl-vars '((user . "user")
                            (ignored . ((a b) (: a space b)))
                            (realname . (group (+ graph)))))
         (erc-d-match-handlers
          (list :user
                (lambda (d e)
                  (erc-d-exchange-rebind
                   d e 'nick
                   (lambda (a)
                     (push 'bind-nick tally)
                     (funcall a :rebind 'nick (funcall a :match 1) 'export)))
                  (erc-d-exchange-rebind
                   d e 'dom
                   (lambda ()
                     (push 'bind-dom tally)
                     (erc-d-exchange-rebind d e 'dom erc-d-server-fqdn)))
                  (erc-d-tests--dynamic-match-user d e))
                :mode-user
                (lambda (d e)
                  (erc-d-exchange-rebind d e 'nick "tester")
                  (erc-d-exchange-rebind d e 'dom erc-d-server-fqdn))))
         (erc-d-server-fqdn "irc.fsf.org"))
    (erc-d-tests--run-dynamic)
    (should (equal '(bind-nick bind-dom) tally))))

(ert-deftest erc-d-run-dynamic-runtime-stub ()
  :tags '(:expensive-test)
  (let ((erc-d-tmpl-vars '((token . (group (or "barnet" "foonet")))))
        (erc-d-match-handlers
         (list :pass (lambda (d _e)
                       (erc-d-load-replacement-dialog d 'dynamic-foonet))))
        (erc-d-tests-with-server-password "foonet:changeme"))
    (erc-d-tests-with-server (_ erc-server-buffer)
        (dynamic-stub dynamic-foonet)
      (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
        (erc-d-t-search-for 2 "alice:")
        (erc-d-t-absent-for 0.1 "joe"))
      (with-current-buffer erc-server-buffer
        (let ((expect (erc-d-t-make-expecter)))
          (funcall expect 2 "host is irc.foonet.org")
          (funcall expect 2 "NETWORK=FooNet")))
      (when noninteractive
        (kill-buffer "#chan")))))

(ert-deftest erc-d-run-dynamic-runtime-stub-skip ()
  :tags '(:expensive-test)
  (let ((erc-d-tmpl-vars '((token . "barnet")))
        (erc-d-match-handlers
         (list :pass (lambda (d _e)
                       (erc-d-load-replacement-dialog
                        d 'dynamic-barnet 1))))
        (erc-d-tests-with-server-password "barnet:changeme"))
    (erc-d-tests-with-server (_ erc-server-buffer)
        (dynamic-stub dynamic-barnet)
      (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
        (erc-d-t-search-for 2 "joe:")
        (erc-d-t-absent-for 0.1 "alice"))
      (with-current-buffer erc-server-buffer
        (let ((expect (erc-d-t-make-expecter)))
          (funcall expect 2 "host is irc.barnet.org")
          (funcall expect 2 "NETWORK=BarNet")))
      (when noninteractive
        (kill-buffer "#chan")))))

;; Two servers, in-process, one client per
(ert-deftest erc-d-run-dual-direct ()
  :tags '(:expensive-test)
  (let* ((erc-d--slow-mo -1)
         (server-a (erc-d-run "localhost" t "erc-d-server-a" 'dynamic-foonet))
         (server-b (erc-d-run "localhost" t "erc-d-server-b" 'dynamic-barnet))
         (server-a-buffer (get-buffer "*erc-d-server-a*"))
         (server-b-buffer (get-buffer "*erc-d-server-b*"))
         (client-a-buffer (get-buffer-create "*erc-d-client-a*"))
         (client-b-buffer (get-buffer-create "*erc-d-client-b*"))
         client-a client-b)
    (with-current-buffer server-a-buffer (erc-d-t-search-for 4 "Starting"))
    (with-current-buffer server-b-buffer (erc-d-t-search-for 4 "Starting"))
    (setq client-a (make-network-process
                    :buffer client-a-buffer
                    :name "erc-d-client-a"
                    :family 'ipv4
                    :noquery t
                    :coding 'binary
                    :service (process-contact server-a :service)
                    :host "localhost")
          client-b (make-network-process
                    :buffer client-b-buffer
                    :name "erc-d-client-b"
                    :family 'ipv4
                    :noquery t
                    :coding 'binary
                    :service (process-contact server-b :service)
                    :host "localhost"))
    ;; Also tests slo-mo indirectly because FAKE would fail without it
    (process-send-string client-a "NICK tester\r\n")
    (process-send-string client-b "FAKE noop\r\nNICK tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-a "USER user 0 * :tester\r\n")
    (process-send-string client-b "USER user 0 * :tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-a "MODE tester +i\r\n")
    (process-send-string client-b "MODE tester +i\r\n")
    (sleep-for 0.01)
    (process-send-string client-a "MODE #chan\r\n")
    (process-send-string client-b "MODE #chan\r\n")
    (sleep-for 0.01)
    (erc-d-t-wait-for 2 "server-a death" (not (process-live-p server-a)))
    (erc-d-t-wait-for 2 "server-b death" (not (process-live-p server-b)))
    (when noninteractive
      (kill-buffer client-a-buffer)
      (kill-buffer client-b-buffer)
      (kill-buffer server-a-buffer)
      (kill-buffer server-b-buffer))))

;; This can be removed; only exists to get a baseline for next test
(ert-deftest erc-d-run-fuzzy-direct ()
  :tags '(:expensive-test)
  (let* ((erc-d-tmpl-vars
          `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))
         (dumb-server (erc-d-run "localhost" t 'fuzzy))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer (get-buffer-create "*erc-d-client*"))
         client)
    (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
    (setq client (make-network-process
                  :buffer client-buffer
                  :name "erc-d-client"
                  :family 'ipv4
                  :noquery t
                  :coding 'binary
                  :service (process-contact dumb-server :service)
                  :host "localhost"))
    ;; We could also just send this as a single fatty
    (process-send-string client "PASS :changeme\r\n")
    (sleep-for 0.01)
    (process-send-string client "NICK tester\r\n")
    (sleep-for 0.01)
    (process-send-string client "USER user 0 * :tester\r\n")
    (sleep-for 0.01)
    (process-send-string client "MODE tester +i\r\n")
    (sleep-for 0.01)
    (process-send-string client "JOIN #bar\r\n")
    (sleep-for 0.01)
    (process-send-string client "JOIN #foo\r\n")
    (sleep-for 0.01)
    (process-send-string client "MODE #bar\r\n")
    (sleep-for 0.01)
    (process-send-string client "MODE #foo\r\n")
    (sleep-for 0.01)
    (erc-d-t-wait-for 1 "dumb-server death"
      (not (process-live-p dumb-server)))
    (when noninteractive
      (kill-buffer client-buffer)
      (kill-buffer dumb-server-buffer))))

;; Without adjusting penalty, takes ~15 secs. With is comparable to direct ^.
(ert-deftest erc-d-run-fuzzy ()
  :tags '(:expensive-test)
  (let ((erc-server-flood-penalty 1.2) ; penalty < margin/sends is basically 0
        (erc-d-linger-secs 0.1)
        (erc-d-tmpl-vars
         `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))
        erc-server-auto-reconnect)
    (erc-d-tests-with-server (_ erc-server-buffer) fuzzy
      (with-current-buffer erc-server-buffer
        (erc-d-t-search-for 2 "away")
        (goto-char erc-input-marker)
        (erc-cmd-JOIN "#bar"))
      (erc-d-t-wait-for 2 (get-buffer "#bar"))
      (with-current-buffer erc-server-buffer
        (erc-cmd-JOIN "#foo"))
      (erc-d-t-wait-for 20 (get-buffer "#foo"))
      (with-current-buffer "#bar"
        (erc-d-t-search-for 1 "was created on"))
      (with-current-buffer "#foo"
        (erc-d-t-search-for 5 "was created on")))))

(ert-deftest erc-d-run-no-block ()
  :tags '(:expensive-test)
  (let ((erc-server-flood-penalty 1)
        (erc-d-linger-secs 1.2)
        (expect (erc-d-t-make-expecter))
        erc-server-auto-reconnect)
    (erc-d-tests-with-server (_ erc-server-buffer) no-block
      (with-current-buffer erc-server-buffer
        (funcall expect 2 "away")
        (funcall expect 1 erc-prompt)
        (with-current-buffer erc-server-buffer (erc-cmd-JOIN "#foo")))
      (with-current-buffer (erc-d-t-wait-for 2 (get-buffer "#foo"))
        (funcall expect 2 "was created on"))

      (ert-info ("Join #bar")
        (with-current-buffer erc-server-buffer (erc-cmd-JOIN "#bar"))
        (erc-d-t-wait-for 2 (get-buffer "#bar")))

      (with-current-buffer "#bar" (funcall expect 1 "was created on"))

      (ert-info ("Server expects next pattern but keeps sending")
        (with-current-buffer "#foo" (funcall expect 2 "Rosalind, I will "))
        (with-current-buffer "#bar" (funcall expect 1 "hi 123"))
        (with-current-buffer "#foo"
          (should-not (search-forward "<bob> I am heard" nil t))
          (funcall expect 1.5 "<bob> I am heard"))))))

(defun erc-d-tests--run-proxy-direct (dumb-server dumb-server-buffer port)
  "Start DUMB-SERVER with DUMB-SERVER-BUFFER and PORT.
These are steps shared by in-proc and subproc variants testing a
bouncer-like setup."
  (when (version< emacs-version "28") (ert-skip "TODO connection refused"))
  (let ((client-buffer-foo (get-buffer-create "*erc-d-client-foo*"))
        (client-buffer-bar (get-buffer-create "*erc-d-client-bar*"))
        (expect (erc-d-t-make-expecter))
        client-foo
        client-bar)
    (setq client-foo (make-network-process
                      :buffer client-buffer-foo
                      :name "erc-d-client-foo"
                      :family 'ipv4
                      :noquery t
                      :coding 'binary
                      :service port
                      :host "localhost")
          client-bar (make-network-process
                      :buffer client-buffer-bar
                      :name "erc-d-client-bar"
                      :family 'ipv4
                      :noquery t
                      :coding 'binary
                      :service port
                      :host "localhost"))
    (with-current-buffer dumb-server-buffer
      (funcall expect 3 "open from"))
    (process-send-string client-foo "PASS :foo:changeme\r\n")
    (process-send-string client-bar "PASS :bar:changeme\r\n")
    (sleep-for 0.01)
    (process-send-string client-foo "NICK tester\r\n")
    (process-send-string client-bar "NICK tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-foo "USER user 0 * :tester\r\n")
    (process-send-string client-bar "USER user 0 * :tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-foo "MODE tester +i\r\n")
    (process-send-string client-bar "MODE tester +i\r\n")
    (sleep-for 0.01)
    (with-current-buffer client-buffer-foo
      (funcall expect 3 "FooNet")
      (funcall expect 3 "irc.foo.net")
      (funcall expect 3 "marked as being away")
      (goto-char (point-min))
      (should-not (search-forward "bar" nil t)))
    (with-current-buffer client-buffer-bar
      (funcall expect 3 "BarNet")
      (funcall expect 3 "irc.bar.net")
      (funcall expect 3 "marked as being away")
      (goto-char (point-min))
      (should-not (search-forward "foo" nil t)))
    (erc-d-t-wait-for 2 "dumb-server death"
      (not (process-live-p dumb-server)))
    (delete-process client-foo)
    (delete-process client-bar)
    (when noninteractive
      (kill-buffer client-buffer-foo)
      (kill-buffer client-buffer-bar)
      (kill-buffer dumb-server-buffer))))

;; This test shows the simplest way to set up template variables: put
;; everything needed for the whole session in `erc-d-tmpl-vars' before
;; starting the server.

(ert-deftest erc-d-run-proxy-direct-spec-vars ()
  :tags '(:expensive-test)
  (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*"))
         (erc-d-linger-secs 0.5)
         (erc-d-tmpl-vars
          `((network . (group (+ alpha)))
            (fqdn . ,(lambda (a)
                       (let ((network (funcall a :match 1 'pass)))
                         (should (member network '("foo" "bar")))
                         (funcall a :set (concat "irc." network ".net")))))
            (net . ,(lambda (a)
                      (let ((network (funcall a :match 1 'pass)))
                        (should (member network '("foo" "bar")))
                        (concat (capitalize network) "Net"))))))
         (dumb-server (erc-d-run "localhost" t 'proxy-foonet 'proxy-barnet))
         (port (process-contact dumb-server :service)))
    (with-current-buffer dumb-server-buffer
      (erc-d-t-search-for 3 "Starting"))
    (erc-d-tests--run-proxy-direct dumb-server dumb-server-buffer port)))

(cl-defun erc-d-tests--start-server (&key dialogs buffer linger program libs)
  "Start and return a server in a subprocess using BUFFER and PORT.
DIALOGS are symbols representing the base names of dialog files in
`erc-d-u-canned-dialog-dir'.  LIBS are extra files to load."
  (push (locate-library "erc-d" nil (list erc-d-u--library-directory)) libs)
  (cl-assert (car libs))
  (let* ((args `("erc-d-server" ,buffer
                 ,(concat invocation-directory invocation-name)
                 "-Q" "-batch" "-L" ,erc-d-u--library-directory
                 ,@(let (o) (while libs (push (pop libs) o) (push "-l" o)) o)
                 "-eval" ,(format "%S" program) "-f" "erc-d-serve"
                 ,@(when linger (list "--linger" (number-to-string linger)))
                 ,@(mapcar #'erc-d-u--expand-dialog-symbol dialogs)))
         (proc (apply #'start-process args)))
    (set-process-query-on-exit-flag proc nil)
    (with-current-buffer buffer
      (erc-d-t-search-for 5 "Starting")
      (search-forward " (")
      (backward-char))
    (let ((pair (read buffer)))
      (cons proc (cdr pair)))))

(ert-deftest erc-d-run-proxy-direct-subprocess ()
  :tags '(:expensive-test)
  (let* ((buffer (get-buffer-create "*erc-d-server*"))
         ;; These are quoted because they're passed as printed forms to subproc
         (fqdn '(lambda (a e)
                  (let* ((d (erc-d-exchange-dialog e))
                         (name (erc-d-dialog-name d)))
                    (funcall a :set (if (eq name 'proxy-foonet)
                                        "irc.foo.net"
                                      "irc.bar.net")))))
         (net '(lambda (a)
                 (funcall a :rebind 'net
                          (if (eq (funcall a :dialog-name) 'proxy-foonet)
                              "FooNet"
                            "BarNet"))))
         (program `(setq erc-d-tmpl-vars '((fqdn . ,fqdn)
                                           (net . ,net)
                                           (network . (group (+ alpha))))))
         (port (erc-d-tests--start-server
                :linger 0.3
                :program program
                :buffer buffer
                :dialogs '(proxy-foonet proxy-barnet)))
         (server (pop port)))
    (erc-d-tests--run-proxy-direct server buffer port)))

(ert-deftest erc-d-run-proxy-direct-subprocess-lib ()
  :tags '(:expensive-test)
  (let* ((buffer (get-buffer-create "*erc-d-server*"))
         (lib (expand-file-name "proxy-subprocess.el"
                                (ert-resource-directory)))
         (port (erc-d-tests--start-server :linger 0.3
                                          :buffer buffer
                                          :dialogs '(proxy-foonet proxy-barnet)
                                          :libs (list lib)))
         (server (pop port)))
    (erc-d-tests--run-proxy-direct server buffer port)))

(ert-deftest erc-d-run-no-pong ()
  :tags '(:expensive-test)
  (let* (erc-d-auto-pong
         ;;
         (erc-d-tmpl-vars
          `((nonce . (group (: digit digit)))
            (echo . ,(lambda (a)
                       (should (string= (funcall a :match 1) "42")) "42"))))
         (dumb-server-buffer (get-buffer-create "*erc-d-server*"))
         (dumb-server (erc-d-run "localhost" t 'no-pong))
         (expect (erc-d-t-make-expecter))
         (client-buf (get-buffer-create "*erc-d-client*"))
         client-proc)
    (with-current-buffer dumb-server-buffer
      (erc-d-t-search-for 3 "Starting"))
    (setq client-proc (make-network-process
                       :buffer client-buf
                       :name "erc-d-client"
                       :family 'ipv4
                       :noquery t
                       :coding 'binary
                       :service (process-contact dumb-server :service)
                       :host "localhost"))
    (with-current-buffer dumb-server-buffer
      (funcall expect 3 "open from"))
    (process-send-string client-proc "PASS :changeme\r\nNICK tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-proc "USER user 0 * :tester\r\n")
    (sleep-for 0.01)
    (process-send-string client-proc "MODE tester +i\r\n")
    (sleep-for 0.01)
    (with-current-buffer client-buf
      (funcall expect 3 "ExampleOrg")
      (funcall expect 3 "irc.example.org")
      (funcall expect 3 "marked as being away"))
    (ert-info ("PING is not intercepted by specialized method")
      (process-send-string client-proc "PING 42\r\n")
      (with-current-buffer client-buf
        (funcall expect 3 "PONG")))
    (erc-d-t-wait-for 2 "dumb-server death"
      (not (process-live-p dumb-server)))
    (delete-process client-proc)
    (when noninteractive
      (kill-buffer client-buf)
      (kill-buffer dumb-server-buffer))))

;; Inspect replies as they arrive within a single exchange, i.e., ensure we
;; don't regress to prior buggy version in which inspection wasn't possible
;; until all replies had been sent by the server.
(ert-deftest erc-d-run-incremental ()
  :tags '(:expensive-test)
  (let ((erc-server-flood-penalty 0)
        (expect (erc-d-t-make-expecter))
        erc-d-linger-secs)
    (erc-d-tests-with-server (_ erc-server-buffer) incremental
      (with-current-buffer erc-server-buffer
        (funcall expect 3 "marked as being away"))
      (with-current-buffer erc-server-buffer
        (erc-cmd-JOIN "#foo"))
      (with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo"))
        (funcall expect 1 "Users on #foo")
        (funcall expect 1 "Look for me")
        (not (search-forward "Done" nil t))
        (funcall expect 10 "Done")
        (erc-send-message "Hi")))))

(ert-deftest erc-d-unix-socket-direct ()
  :tags '(:expensive-test)
  (skip-unless (featurep 'make-network-process '(:family local)))
  (let* ((erc-d-linger-secs 0.1)
         (sock (expand-file-name "erc-d.sock" temporary-file-directory))
         (dumb-server (erc-d-run nil sock 'basic))
         (dumb-server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer (get-buffer-create "*erc-d-client*"))
         client)
    (with-current-buffer "*erc-d-server*"
      (erc-d-t-search-for 4 "Starting"))
    (unwind-protect
        (progn
          (setq client (make-network-process
                        :buffer client-buffer
                        :name "erc-d-client"
                        :family 'local
                        :noquery t
                        :coding 'binary
                        :service sock))
          (process-send-string client "PASS :changeme\r\n")
          (sleep-for 0.01)
          (process-send-string client "NICK tester\r\n")
          (sleep-for 0.01)
          (process-send-string client "USER user 0 * :tester\r\n")
          (sleep-for 0.1)
          (process-send-string client "MODE tester +i\r\n")
          (sleep-for 0.01)
          (process-send-string client "MODE #chan\r\n")
          (sleep-for 0.01)
          (erc-d-t-wait-for 1 "dumb-server death"
            (not (process-live-p dumb-server)))
          (when noninteractive
            (kill-buffer client-buffer)
            (kill-buffer dumb-server-buffer)))
      (delete-file sock))))

(ert-deftest erc-d-run-direct-foreign-protocol ()
  :tags '(:expensive-test)
  (let* ((server (erc-d-run "localhost" t "erc-d-server" 'foreign
                            :ending "\n"))
         (server-buffer (get-buffer "*erc-d-server*"))
         (client-buffer (get-buffer-create "*erc-d-client*"))
         client)
    (with-current-buffer server-buffer (erc-d-t-search-for 4 "Starting"))
    (setq client (make-network-process
                  :buffer client-buffer
                  :name "erc-d-client"
                  :family 'ipv4
                  :noquery t
                  :coding 'binary
                  :service (process-contact server :service)
                  :host "localhost"))
    (process-send-string client "ONE one\n")
    (with-current-buffer client-buffer
      (erc-d-t-search-for 5 "echo ONE one"))
    (process-send-string client "TWO two\n")
    (with-current-buffer client-buffer
      (erc-d-t-search-for 2 "echo TWO two"))
    (erc-d-t-wait-for 2 "server death" (not (process-live-p server)))
    (when noninteractive
      (kill-buffer client-buffer)
      (kill-buffer server-buffer))))

;;; erc-d-tests.el ends here