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

;; Copyright (C) 2020-2022 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/>.

;;; Commentary:

;; TODO: move the auth-source tests somewhere else.  They've been
;; stashed here for pragmatic reasons.

;;; Code:

(require 'ert-x)
(require 'erc-services)
(require 'erc-compat)
(require 'secrets)

;;;; Core auth-source

(ert-deftest erc--auth-source-determine-params-merge ()
  (let ((erc-session-server "irc.gnu.org")
        (erc-server-announced-name "my.gnu.org")
        (erc-session-port 6697)
        (erc-network 'fake)
        (erc-server-current-nick "tester")
        (erc-networks--id (erc-networks--id-create 'GNU.chat)))

    (should (equal (erc--auth-source-determine-params-merge)
                   '(:host ("GNU.chat" "my.gnu.org" "irc.gnu.org")
                           :port ("6697" "irc")
                           :require (:secret))))

    (should (equal (erc--auth-source-determine-params-merge :host "fake")
                   '(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
                           :port ("6697" "irc")
                           :require (:secret))))

    (should (equal (erc--auth-source-determine-params-merge
                    :host '("fake") :require :host)
                   '(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
                           :require (:host :secret)
                           :port ("6697" "irc"))))

    (should (equal (erc--auth-source-determine-params-merge
                    :host '("fake" "GNU.chat") :port "1234" :x "x")
                   '(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
                           :port ("1234" "6697" "irc")
                           :x ("x")
                           :require (:secret))))))

;; Some of the following may be related to bug#23438.

(defun erc-services-tests--auth-source-standard (search)

  (ert-info ("Session wins")
    (let ((erc-session-server "irc.gnu.org")
          (erc-server-announced-name "my.gnu.org")
          (erc-session-port 6697)
          (erc-network 'fake)
          (erc-server-current-nick "tester")
          (erc-networks--id (erc-networks--id-create 'GNU.chat)))
      (should (string= (funcall search :user "#chan") "foo"))))

  (ert-info ("Network wins")
    (let* ((erc-session-server "irc.gnu.org")
           (erc-server-announced-name "my.gnu.org")
           (erc-session-port 6697)
           (erc-network 'GNU.chat)
           (erc-server-current-nick "tester")
           (erc-networks--id (erc-networks--id-create nil)))
      (should (string= (funcall search :user "#chan") "foo"))))

  (ert-info ("Announced wins")
    (let ((erc-session-server "irc.gnu.org")
          (erc-server-announced-name "my.gnu.org")
          (erc-session-port 6697)
          erc-network
          (erc-networks--id (erc-networks--id-create nil)))
      (should (string= (funcall search :user "#chan") "baz")))))

(defun erc-services-tests--auth-source-announced (search)
  (let* ((erc--isupport-params (make-hash-table))
         (erc-server-parameters '(("CHANTYPES" . "&#")))
         (erc--target (erc--target-from-string "&chan")))

    (ert-info ("Announced prioritized")

      (ert-info ("Announced wins")
        (let* ((erc-session-server "irc.gnu.org")
               (erc-server-announced-name "my.gnu.org")
               (erc-session-port 6697)
               (erc-network 'GNU.chat)
               (erc-server-current-nick "tester")
               (erc-networks--id (erc-networks--id-create nil)))
          (should (string= (funcall search :user "#chan") "baz"))))

      (ert-info ("Peer next")
        (let* ((erc-server-announced-name "irc.gnu.org")
               (erc-session-port 6697)
               (erc-network 'GNU.chat)
               (erc-server-current-nick "tester")
               (erc-networks--id (erc-networks--id-create nil)))
          (should (string= (funcall search :user "#chan") "bar"))))

      (ert-info ("Network used as fallback")
        (let* ((erc-session-port 6697)
               (erc-network 'GNU.chat)
               (erc-server-current-nick "tester")
               (erc-networks--id (erc-networks--id-create nil)))
          (should (string= (funcall search :user "#chan") "foo")))))))

(defun erc-services-tests--auth-source-overrides (search)
  (let* ((erc-session-server "irc.gnu.org")
         (erc-server-announced-name "my.gnu.org")
         (erc-network 'GNU.chat)
         (erc-server-current-nick "tester")
         (erc-networks--id (erc-networks--id-create nil))
         (erc-session-port 6667))

    (ert-info ("Specificity and overrides")

      (ert-info ("More specific port")
        (let ((erc-session-port 6697))
          (should (string= (funcall search :user "#chan") "spam"))))

      (ert-info ("More specific user (network loses)")
        (should (string= (funcall search :user '("#fsf")) "42")))

      (ert-info ("Actual override")
        (should (string= (funcall search :port "6667") "sesame")))

      (ert-info ("Overrides don't interfere with post-processing")
        (should (string= (funcall search :host "MyHost") "123"))))))

;; auth-source netrc backend

(defvar erc-services-tests--auth-source-entries
  '("machine irc.gnu.org port irc user \"#chan\" password bar"
    "machine my.gnu.org port irc user \"#chan\" password baz"
    "machine GNU.chat port irc user \"#chan\" password foo"))

;; FIXME explain what this is for
(defun erc-services-tests--auth-source-shuffle (&rest extra)
  (string-join `(,@(sort (append erc-services-tests--auth-source-entries extra)
                         (lambda (&rest _) (zerop (random 2))))
                 "")
               "\n"))

(ert-deftest erc--auth-source-search--netrc-standard ()
  (ert-with-temp-file netrc-file
    :prefix "erc--auth-source-search--standard"
    :text (erc-services-tests--auth-source-shuffle)

    (let ((auth-sources (list netrc-file))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-standard #'erc-auth-source-search))))

(ert-deftest erc--auth-source-search--netrc-announced ()
  (ert-with-temp-file netrc-file
    :prefix "erc--auth-source-search--announced"
    :text (erc-services-tests--auth-source-shuffle)

    (let ((auth-sources (list netrc-file))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-announced #'erc-auth-source-search))))

(ert-deftest erc--auth-source-search--netrc-overrides ()
  (ert-with-temp-file netrc-file
    :prefix "erc--auth-source-search--overrides"
    :text (erc-services-tests--auth-source-shuffle
           "machine GNU.chat port 6697 user \"#chan\" password spam"
           "machine my.gnu.org port irc user \"#fsf\" password 42"
           "machine irc.gnu.org port 6667 password sesame"
           "machine MyHost port irc password 456"
           "machine MyHost port 6667 password 123")

    (let ((auth-sources (list netrc-file))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-overrides #'erc-auth-source-search))))

;; auth-source plstore backend

(defun erc-services-test--call-with-plstore (&rest args)
  (advice-add 'epg-decrypt-string :override
              (lambda (&rest r) (prin1-to-string (cadr r)))
              '((name . erc--auth-source-plstore)))
  (advice-add 'epg-find-configuration :override
              (lambda (&rest _) "" '((program . "/bin/true")))
              '((name . erc--auth-source-plstore)))
  (unwind-protect
      (apply #'erc-auth-source-search args)
    (advice-remove 'epg-decrypt-string 'erc--auth-source-plstore)
    (advice-remove 'epg-find-configuration 'erc--auth-source-plstore)))

(defvar erc-services-tests--auth-source-plstore-standard-entries
  '(("ba950d38118a76d71f9f0591bb373d6cb366a512"
     :secret-secret t
     :host "irc.gnu.org"
     :user "#chan"
     :port "irc")
    ("7f17ca445d11158065e911a6d0f4cbf52ca250e3"
     :secret-secret t
     :host "my.gnu.org"
     :user "#chan"
     :port "irc")
    ("fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377"
     :secret-secret t
     :host "GNU.chat"
     :user "#chan"
     :port "irc")))

(defvar erc-services-tests--auth-source-plstore-standard-secrets
  '(("ba950d38118a76d71f9f0591bb373d6cb366a512" :secret "bar")
    ("7f17ca445d11158065e911a6d0f4cbf52ca250e3" :secret "baz")
    ("fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377" :secret "foo")))

(ert-deftest erc--auth-source-search--plstore-standard ()
  (ert-with-temp-file plstore-file
    :suffix ".plist"
    :text (concat ";;; public entries -*- mode: plstore -*- \n"
                  (prin1-to-string
                   erc-services-tests--auth-source-plstore-standard-entries)
                  "\n;;; secret entries\n"
                  (prin1-to-string
                   erc-services-tests--auth-source-plstore-standard-secrets)
                  "\n")

    (let ((auth-sources (list plstore-file))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-standard
       #'erc-services-test--call-with-plstore))))

(ert-deftest erc--auth-source-search--plstore-announced ()
  (ert-with-temp-file plstore-file
    :suffix ".plist"
    :text (concat ";;; public entries -*- mode: plstore -*- \n"
                  (prin1-to-string
                   erc-services-tests--auth-source-plstore-standard-entries)
                  "\n;;; secret entries\n"
                  (prin1-to-string
                   erc-services-tests--auth-source-plstore-standard-secrets)
                  "\n")

    (let ((auth-sources (list plstore-file))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-announced
       #'erc-services-test--call-with-plstore))))

(ert-deftest erc--auth-source-search--plstore-overrides ()
  (ert-with-temp-file plstore-file
    :suffix ".plist"
    :text (concat
           ";;; public entries -*- mode: plstore -*- \n"
           (prin1-to-string
            `(,@erc-services-tests--auth-source-plstore-standard-entries
              ("1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a"
               :secret-secret t :host "GNU.chat" :user "#chan" :port "6697")
              ("6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc"
               :secret-secret t :host "my.gnu.org" :user "#fsf" :port "irc")
              ("a33e2b3bd2d6f33995a4b88710a594a100c5e41d"
               :secret-secret t :host "irc.gnu.org" :port "6667")
              ("ab2fd349b2b7d6a9215bb35a92d054261b0b1537"
               :secret-secret t :host "MyHost" :port "irc")
              ("61a6bd552059494f479ff720e8de33e22574650a"
               :secret-secret t :host "MyHost" :port "6667")))
           "\n;;; secret entries\n"
           (prin1-to-string
            `(,@erc-services-tests--auth-source-plstore-standard-secrets
              ("1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a" :secret "spam")
              ("6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc" :secret "42")
              ("a33e2b3bd2d6f33995a4b88710a594a100c5e41d" :secret "sesame")
              ("ab2fd349b2b7d6a9215bb35a92d054261b0b1537" :secret "456")
              ("61a6bd552059494f479ff720e8de33e22574650a" :secret "123")))
           "\n")

    (let ((auth-sources (list plstore-file))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-overrides
       #'erc-services-test--call-with-plstore))))

;; auth-source JSON backend

(defvar erc-services-tests--auth-source-json-standard-entries
  [(:host "irc.gnu.org" :port "irc" :user "#chan" :secret "bar")
   (:host "my.gnu.org" :port "irc" :user "#chan" :secret "baz")
   (:host "GNU.chat" :port "irc" :user "#chan" :secret "foo")])

(ert-deftest erc--auth-source-search--json-standard ()
  (ert-with-temp-file json-store
    :suffix ".json"
    :text (let ((json-object-type 'plist))
            (json-encode
             erc-services-tests--auth-source-json-standard-entries))
    (let ((auth-sources (list json-store))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-standard #'erc-auth-source-search))))

(ert-deftest erc--auth-source-search--json-announced ()
  (ert-with-temp-file plstore-file
    :suffix ".json"
    :text (let ((json-object-type 'plist))
            (json-encode
             erc-services-tests--auth-source-json-standard-entries))

    (let ((auth-sources (list plstore-file))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-announced #'erc-auth-source-search))))

(ert-deftest erc--auth-source-search--json-overrides ()
  (ert-with-temp-file json-file
    :suffix ".json"
    :text (let ((json-object-type 'plist))
            (json-encode
             (vconcat
              erc-services-tests--auth-source-json-standard-entries
              [(:secret "spam" :host "GNU.chat" :user "#chan" :port "6697")
               (:secret "42" :host "my.gnu.org" :user "#fsf" :port "irc")
               (:secret "sesame" :host "irc.gnu.org" :port "6667")
               (:secret "456" :host "MyHost" :port "irc")
               (:secret "123" :host "MyHost" :port "6667")])))

    (let ((auth-sources (list json-file))
          (auth-source-do-cache nil))
      (erc-services-tests--auth-source-overrides #'erc-auth-source-search))))

;; auth-source-secrets backend

(defvar erc-services-tests--auth-source-secrets-standard-entries
  '(("#chan@irc.gnu.org:irc" ; label
     (:host . "irc.gnu.org")
     (:user . "#chan")
     (:port . "irc")
     (:xdg:schema . "org.freedesktop.Secret.Generic"))
    ("#chan@my.gnu.org:irc"
     (:host . "my.gnu.org")
     (:user . "#chan")
     (:port . "irc")
     (:xdg:schema . "org.freedesktop.Secret.Generic"))
    ("#chan@GNU.chat:irc"
     (:host . "GNU.chat")
     (:user . "#chan")
     (:port . "irc")
     (:xdg:schema . "org.freedesktop.Secret.Generic"))))

(defvar erc-services-tests--auth-source-secrets-standard-secrets
  '(("#chan@irc.gnu.org:irc" . "bar")
    ("#chan@my.gnu.org:irc" . "baz")
    ("#chan@GNU.chat:irc" . "foo")))

(ert-deftest erc--auth-source-search--secrets-standard ()
  (skip-unless (bound-and-true-p secrets-enabled))
  (let ((auth-sources '("secrets:Test"))
        (auth-source-do-cache nil)
        (entries erc-services-tests--auth-source-secrets-standard-entries)
        (secrets erc-services-tests--auth-source-secrets-standard-secrets))

    (cl-letf (((symbol-function 'secrets-search-items)
               (lambda (col &rest r)
                 (should (equal col "Test"))
                 (should (plist-get r :user))
                 (map-keys entries)))
              ((symbol-function 'secrets-get-secret)
               (lambda (col label)
                 (should (equal col "Test"))
                 (assoc-default label secrets)))
              ((symbol-function 'secrets-get-attributes)
               (lambda (col label)
                 (should (equal col "Test"))
                 (assoc-default label entries))))

      (erc-services-tests--auth-source-standard #'erc-auth-source-search))))

(ert-deftest erc--auth-source-search--secrets-announced ()
  (skip-unless (bound-and-true-p secrets-enabled))
  (let ((auth-sources '("secrets:Test"))
        (auth-source-do-cache nil)
        (entries erc-services-tests--auth-source-secrets-standard-entries)
        (secrets erc-services-tests--auth-source-secrets-standard-secrets))

    (cl-letf (((symbol-function 'secrets-search-items)
               (lambda (col &rest r)
                 (should (equal col "Test"))
                 (should (plist-get r :user))
                 (map-keys entries)))
              ((symbol-function 'secrets-get-secret)
               (lambda (col label)
                 (should (equal col "Test"))
                 (assoc-default label secrets)))
              ((symbol-function 'secrets-get-attributes)
               (lambda (col label)
                 (should (equal col "Test"))
                 (assoc-default label entries))))

      (erc-services-tests--auth-source-announced #'erc-auth-source-search))))

(ert-deftest erc--auth-source-search--secrets-overrides ()
  (skip-unless (bound-and-true-p secrets-enabled))
  (let ((auth-sources '("secrets:Test"))
        (auth-source-do-cache nil)
        (entries `(,@erc-services-tests--auth-source-secrets-standard-entries
                   ("#chan@GNU.chat:6697"
                    (:host . "GNU.chat") (:user . "#chan") (:port . "6697")
                    (:xdg:schema . "org.freedesktop.Secret.Generic"))
                   ("#fsf@my.gnu.org:irc"
                    (:host . "my.gnu.org") (:user . "#fsf") (:port . "irc")
                    (:xdg:schema . "org.freedesktop.Secret.Generic"))
                   ("irc.gnu.org:6667"
                    (:host . "irc.gnu.org") (:port . "6667")
                    (:xdg:schema . "org.freedesktop.Secret.Generic"))
                   ("MyHost:irc"
                    (:host . "MyHost") (:port . "irc")
                    (:xdg:schema . "org.freedesktop.Secret.Generic"))
                   ("MyHost:6667"
                    (:host . "MyHost") (:port . "6667")
                    (:xdg:schema . "org.freedesktop.Secret.Generic"))))
        (secrets `(,@erc-services-tests--auth-source-secrets-standard-secrets
                   ("#chan@GNU.chat:6697" . "spam")
                   ("#fsf@my.gnu.org:irc" . "42" )
                   ("irc.gnu.org:6667" . "sesame")
                   ("MyHost:irc" . "456")
                   ("MyHost:6667" . "123"))))

    (cl-letf (((symbol-function 'secrets-search-items)
               (lambda (col &rest _)
                 (should (equal col "Test"))
                 (map-keys entries)))
              ((symbol-function 'secrets-get-secret)
               (lambda (col label)
                 (should (equal col "Test"))
                 (assoc-default label secrets)))
              ((symbol-function 'secrets-get-attributes)
               (lambda (col label)
                 (should (equal col "Test"))
                 (assoc-default label entries))))

      (erc-services-tests--auth-source-overrides #'erc-auth-source-search))))

;; auth-source-pass backend

(require 'auth-source-pass)

;; `auth-source-pass--find-match-unambiguous' returns something like:
;;
;;   (list :host "irc.gnu.org"
;;         :port "6697"
;;         :user "rms"
;;         :secret
;;         #[0 "\301\302\300\"\207"
;;             [((secret . "freedom")) auth-source-pass--get-attr secret] 3])
;;
;; This function gives ^ (faked here to avoid gpg and file IO).  See
;; `auth-source-pass--with-store' in ../auth-source-pass-tests.el
(defun erc-services-tests--asp-parse-entry (store entry)
  (when-let ((found (cl-find entry store :key #'car :test #'string=)))
    (list (assoc 'secret (cdr found)))))

(defvar erc-join-tests--auth-source-pass-entries
  '(("irc.gnu.org:irc/#chan"
     ("port" . "irc") ("user" . "#chan") (secret . "bar"))
    ("my.gnu.org:irc/#chan"
     ("port" . "irc") ("user" . "#chan") (secret . "baz"))
    ("GNU.chat:irc/#chan"
     ("port" . "irc") ("user" . "#chan") (secret . "foo"))))

(ert-deftest erc--auth-source-search--pass-standard ()
  (ert-skip "Pass backend not yet supported")
  (let ((store erc-join-tests--auth-source-pass-entries)
        (auth-sources '(password-store))
        (auth-source-do-cache nil))

    (cl-letf (((symbol-function 'auth-source-pass-parse-entry)
               (apply-partially #'erc-services-tests--asp-parse-entry store))
              ((symbol-function 'auth-source-pass-entries)
               (lambda () (mapcar #'car store))))

      (erc-services-tests--auth-source-standard #'erc-auth-source-search))))

(ert-deftest erc--auth-source-search--pass-announced ()
  (ert-skip "Pass backend not yet supported")
  (let ((store erc-join-tests--auth-source-pass-entries)
        (auth-sources '(password-store))
        (auth-source-do-cache nil))

    (cl-letf (((symbol-function 'auth-source-pass-parse-entry)
               (apply-partially #'erc-services-tests--asp-parse-entry store))
              ((symbol-function 'auth-source-pass-entries)
               (lambda () (mapcar #'car store))))

      (erc-services-tests--auth-source-announced #'erc-auth-source-search))))

(ert-deftest erc--auth-source-search--pass-overrides ()
  (ert-skip "Pass backend not yet supported")
  (let ((store
         `(,@erc-join-tests--auth-source-pass-entries
           ("GNU.chat:6697/#chan"
            ("port" . "6697") ("user" . "#chan") (secret . "spam"))
           ("my.gnu.org:irc/#fsf"
            ("port" . "irc") ("user" . "#fsf") (secret . "42"))
           ("irc.gnu.org:6667"
            ("port" . "6667") (secret . "sesame"))
           ("MyHost:irc"
            ("port" . "irc") (secret . "456"))
           ("MyHost:6667"
            ("port" . "6667") (secret . "123"))))
        (auth-sources '(password-store))
        (auth-source-do-cache nil))

    (cl-letf (((symbol-function 'auth-source-pass-parse-entry)
               (apply-partially #'erc-services-tests--asp-parse-entry store))
              ((symbol-function 'auth-source-pass-entries)
               (lambda () (mapcar #'car store))))

      (erc-services-tests--auth-source-overrides #'erc-auth-source-search))))

;;;; The services module

(ert-deftest erc-nickserv-get-password ()
  (should erc-prompt-for-nickserv-password)
  (ert-with-temp-file netrc-file
    :prefix "erc-nickserv-get-password"
    :text (mapconcat 'identity
                     '("machine GNU/chat port 6697 user bob password spam"
                       "machine FSF.chat port 6697 user bob password sesame"
                       "machine MyHost port irc password 123")
                     "\n")

    (let* ((auth-sources (list netrc-file))
           (auth-source-do-cache nil)
           (erc-nickserv-passwords '((FSF.chat (("alice" . "foo")
                                                ("joe" . "bar")))))
           (erc-use-auth-source-for-nickserv-password t)
           (erc-session-server "irc.gnu.org")
           (erc-server-announced-name "my.gnu.org")
           (erc-network 'FSF.chat)
           (erc-server-current-nick "tester")
           (erc-networks--id (erc-networks--id-create nil))
           (erc-session-port 6697))

      (ert-info ("Lookup custom option")
        (should (string= (erc-nickserv-get-password "alice") "foo")))

      (ert-info ("Auth source")
        (ert-info ("Network")
          (should (string= (erc-nickserv-get-password "bob") "sesame")))

        (ert-info ("Network ID")
          (let ((erc-networks--id (erc-networks--id-create 'GNU/chat)))
            (should (string= (erc-nickserv-get-password "bob") "spam")))))

      (ert-info ("Read input")
        (should (string=
                 (ert-simulate-keys "baz\r" (erc-nickserv-get-password "mike"))
                 "baz")))

      (ert-info ("Failed")
        (should-not (ert-simulate-keys "\r"
                      (erc-nickserv-get-password "fake")))))))


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