diff options
Diffstat (limited to 'tests/test-pearl-comment-editing.el')
| -rw-r--r-- | tests/test-pearl-comment-editing.el | 240 |
1 files changed, 240 insertions, 0 deletions
diff --git a/tests/test-pearl-comment-editing.el b/tests/test-pearl-comment-editing.el new file mode 100644 index 0000000..05a3a76 --- /dev/null +++ b/tests/test-pearl-comment-editing.el @@ -0,0 +1,240 @@ +;;; test-pearl-comment-editing.el --- Tests for editing comments -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for editing an existing comment (spec: docs/issue-comment-editing-spec.org). +;; Covers: the author-id retained at normalize time, the per-comment provenance +;; drawer, the editability predicate and highlight pass, the viewer/commentUpdate +;; network helpers (stubbed at the HTTP boundary), and the permission + conflict +;; gates of `pearl-edit-current-comment'. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'testutil-request (expand-file-name "testutil-request.el")) +(require 'cl-lib) + +(defmacro test-pearl--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT." + (declare (indent 1)) + `(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;; normalize-comment keeps the author id + +(ert-deftest test-pearl-normalize-comment-keeps-author-id () + "A user-authored comment retains the user id for the permission check." + (let ((c (pearl--normalize-comment + '((id . "c1") (body . "hi") (createdAt . "2026-05-24T10:00:00.000Z") + (user (id . "u-123") (name . "Craig")))))) + (should (string= "u-123" (plist-get c :author-id))) + (should (string= "Craig" (plist-get c :author))))) + +(ert-deftest test-pearl-normalize-comment-bot-has-no-author-id () + "A bot comment has no user, so author-id is nil (not editable)." + (let ((c (pearl--normalize-comment + '((id . "c1") (body . "hi") (createdAt . "2026-05-24T10:00:00.000Z") + (botActor (name . "Linear")))))) + (should (null (plist-get c :author-id))))) + +;;; format-comment writes the provenance drawer + +(ert-deftest test-pearl-format-comment-writes-drawer () + "A rendered comment carries id, author-id, and a body hash in a drawer." + (let ((out (pearl--format-comment + '(:id "c9" :author-id "u-123" :author "Craig" + :created-at "2026-05-24T10:00:00.000Z" :body "Looks good")))) + (should (string-match-p ":LINEAR-COMMENT-ID:[ \t]+c9" out)) + (should (string-match-p ":LINEAR-COMMENT-AUTHOR-ID:[ \t]+u-123" out)) + (should (string-match-p (format ":LINEAR-COMMENT-SHA256:[ \t]+%s" + (secure-hash 'sha256 "Looks good")) + out)))) + +(ert-deftest test-pearl-format-comment-bot-empty-author-id () + "A comment with no author id renders an empty author-id, not an error." + (let ((out (pearl--format-comment + '(:id "c1" :author "Linear" :created-at "2026-05-24T10:00:00.000Z" + :body "auto")))) + (should (string-match-p "^:LINEAR-COMMENT-AUTHOR-ID:[ \t]*$" out)))) + +;;; editability predicate + +(ert-deftest test-pearl-comment-editable-own () + "A comment whose author is the viewer is editable." + (should (pearl--comment-editable-p "u-1" "u-1"))) + +(ert-deftest test-pearl-comment-editable-other () + "A comment by another user is not editable." + (should-not (pearl--comment-editable-p "u-2" "u-1"))) + +(ert-deftest test-pearl-comment-editable-nil-author () + "A comment with no author id (bot/external) is not editable." + (should-not (pearl--comment-editable-p nil "u-1")) + (should-not (pearl--comment-editable-p "" "u-1"))) + +;;; viewer identity (cached) + +(ert-deftest test-pearl-viewer-async-parses-and-caches () + "The viewer query returns the id/name and caches it for the next call." + (let ((pearl--cache-viewer nil)) + (testutil-linear-with-response + '((data (viewer (id . "u-me") (name . "Craig")))) + (let (v) + (pearl--viewer-async (lambda (r) (setq v r))) + (should (string= "u-me" (plist-get v :id))) + (should (string= "u-me" (plist-get pearl--cache-viewer :id))))) + ;; second call uses the cache, no HTTP needed + (let ((v2 'untouched)) + (pearl--viewer-async (lambda (r) (setq v2 r))) + (should (string= "u-me" (plist-get v2 :id)))))) + +;;; commentUpdate write path + +(ert-deftest test-pearl-update-comment-success () + "A successful commentUpdate reports success." + (testutil-linear-with-response + '((data (commentUpdate (success . t) (comment (id . "c1") (body . "edited"))))) + (let (result) + (pearl--update-comment-async "c1" "edited" (lambda (r) (setq result r))) + (should (eq t (plist-get result :success)))))) + +(ert-deftest test-pearl-update-comment-soft-fail () + "A non-success commentUpdate reports failure rather than erroring." + (testutil-linear-with-response + '((data (commentUpdate (success . :json-false) (comment . nil)))) + (let (result) + (pearl--update-comment-async "c1" "x" (lambda (r) (setq result r))) + (should-not (plist-get result :success))))) + +;;; edit command — permission + conflict gates + +(defconst test-pearl--comment-buffer + (concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + "**** Comments\n" + "***** Craig — 2026-05-24T09:00:00.000Z\n" + ":PROPERTIES:\n" + ":LINEAR-COMMENT-ID: c1\n" + ":LINEAR-COMMENT-AUTHOR-ID: %s\n" + ":LINEAR-COMMENT-SHA256: %s\n" + ":END:\n" + "%s\n") + "Template: author-id, stored-sha, body.") + +(defun test-pearl--comment-doc (author-id stored-body current-body) + "Build a comment buffer: AUTHOR-ID, drawer hash of STORED-BODY, CURRENT-BODY shown." + (format test-pearl--comment-buffer + author-id (secure-hash 'sha256 stored-body) current-body)) + +(ert-deftest test-pearl-edit-comment-not-on-comment-errors () + "Running the edit command outside a comment subtree signals a user error." + (test-pearl--in-org "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + (should-error (pearl-edit-current-comment) :type 'user-error))) + +(ert-deftest test-pearl-edit-comment-refuses-others () + "Editing another user's comment refuses and never calls commentUpdate." + (test-pearl--in-org (test-pearl--comment-doc "u-other" "old" "new text") + (let ((pearl--cache-viewer '(:id "u-me" :name "Me")) + (updated nil) (fetched nil)) + (cl-letf (((symbol-function 'pearl--update-comment-async) + (lambda (&rest _) (setq updated t))) + ((symbol-function 'pearl--fetch-comment-body-async) + (lambda (&rest _) (setq fetched t)))) + (re-search-forward "new text") + (pearl-edit-current-comment) + (should-not updated) + (should-not fetched))))) + +(ert-deftest test-pearl-edit-comment-noop-when-unchanged () + "An unedited comment pushes nothing." + (test-pearl--in-org (test-pearl--comment-doc "u-me" "same" "same") + (let ((pearl--cache-viewer '(:id "u-me" :name "Me")) + (updated nil)) + (cl-letf (((symbol-function 'pearl--update-comment-async) + (lambda (&rest _) (setq updated t)))) + (re-search-forward "same") + (pearl-edit-current-comment) + (should-not updated))))) + +(ert-deftest test-pearl-edit-comment-pushes-own-edit () + "Editing your own comment against an unchanged remote pushes and advances the hash." + (test-pearl--in-org (test-pearl--comment-doc "u-me" "old body" "new body") + (let ((pearl--cache-viewer '(:id "u-me" :name "Me")) + (pushed-body nil)) + (cl-letf (((symbol-function 'pearl--fetch-comment-body-async) + ;; remote is unchanged since fetch (matches the stored hash) + (lambda (_id cb) (funcall cb "old body"))) + ((symbol-function 'pearl--update-comment-async) + (lambda (_id body cb) (setq pushed-body body) + (funcall cb '(:success t))))) + (re-search-forward "new body") + (pearl-edit-current-comment) + (should (string= "new body" pushed-body)) + ;; the stored hash advanced to the pushed body + (goto-char (point-min)) + (re-search-forward "^\\*\\*\\*\\*\\* Craig") + (should (string= (secure-hash 'sha256 "new body") + (org-entry-get nil "LINEAR-COMMENT-SHA256"))))))) + +(ert-deftest test-pearl-edit-comment-refuses-conflict () + "When the remote changed since the fetch, the edit is refused." + (test-pearl--in-org (test-pearl--comment-doc "u-me" "old body" "new body") + (let ((pearl--cache-viewer '(:id "u-me" :name "Me")) + (updated nil)) + (cl-letf (((symbol-function 'pearl--fetch-comment-body-async) + ;; remote drifted from the stored hash -> conflict + (lambda (_id cb) (funcall cb "remote changed body"))) + ((symbol-function 'pearl--update-comment-async) + (lambda (&rest _) (setq updated t))) + ;; On conflict the command now prompts; cancel keeps the old + ;; refuse behavior (no commentUpdate call). + ((symbol-function 'pearl--read-conflict-resolution) + (lambda (_label) 'cancel))) + (re-search-forward "new body") + (pearl-edit-current-comment) + (should-not updated))))) + +;;; editability highlighting + +(ert-deftest test-pearl-highlight-comments-colors-by-editability () + "Own comments get the editable face; others get the read-only face." + (test-pearl--in-org + (concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nBody.\n" + "**** Comments\n" + "***** Me — 2026-05-24T09:00:00.000Z\n" + ":PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:LINEAR-COMMENT-AUTHOR-ID: u-me\n:END:\nmine\n" + "***** Them — 2026-05-24T10:00:00.000Z\n" + ":PROPERTIES:\n:LINEAR-COMMENT-ID: c2\n:LINEAR-COMMENT-AUTHOR-ID: u-other\n:END:\ntheirs\n") + (pearl--apply-comment-highlights "u-me") + (cl-flet ((face-on (pat) + (goto-char (point-min)) + (re-search-forward pat) + (goto-char (line-beginning-position)) + (let ((ov (cl-find-if (lambda (o) (overlay-get o 'pearl-comment)) + (overlays-at (point))))) + (and ov (overlay-get ov 'face))))) + (should (eq 'pearl-editable-comment (face-on "^\\*\\*\\*\\*\\* Me"))) + (should (eq 'pearl-readonly-comment (face-on "^\\*\\*\\*\\*\\* Them")))))) + +(provide 'test-pearl-comment-editing) +;;; test-pearl-comment-editing.el ends here |