;;; test-pearl-comment-editing.el --- Tests for editing comments -*- lexical-binding: t; -*- ;; Copyright (C) 2026 Craig Jennings ;; Author: Craig Jennings ;; 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 . ;;; 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))))) (ert-deftest test-pearl-edit-comment-push-failure-keeps-hash () "A failed comment push keeps the stored hash and the edited body for retry." (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) (stored (secure-hash 'sha256 "old body"))) (cl-letf (((symbol-function 'pearl--fetch-comment-body-async) (lambda (_id cb) (funcall cb "old body"))) ((symbol-function 'pearl--update-comment-async) (lambda (_id body cb) (setq pushed-body body) (funcall cb '(:success nil))))) (re-search-forward "new body") (pearl-edit-current-comment) ;; push attempted with the edited body ... (should (string= "new body" pushed-body)) ;; ... but the stored hash is not advanced and the edit stays. (goto-char (point-min)) (re-search-forward "^\\*\\*\\*\\*\\* Craig") (should (string= stored (org-entry-get nil "LINEAR-COMMENT-SHA256"))) (should (string= "new body" (pearl--issue-body-at-point))))))) ;;; 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