diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 2066161..1efabfb 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -125,16 +125,18 @@ ;; /help command ((and (>= (length text) 9) (string-equal (subseq text 0 9) "/approve ")) - (let ((token (string-trim '(#\Space) (subseq text 9)))) - (send-daemon (list :type :event :payload - (list :action :hitl-respond :token token :decision :approved))) - (add-msg :system (format nil "Approved: ~a" token)))) + (let ((token (string-trim '(#\Space) (subseq text 9)))) + (send-daemon (list :type :event :payload + (list :action :hitl-respond :token token :decision :approved))) + (add-msg :system (format nil "✓ Approved: ~a" token)) + (resolve-hitl-panel :approved))) ((and (>= (length text) 6) (string-equal (subseq text 0 6) "/deny ")) - (let ((token (string-trim '(#\Space) (subseq text 6)))) - (send-daemon (list :type :event :payload - (list :action :hitl-respond :token token :decision :denied))) - (add-msg :system (format nil "Denied: ~a" token)))) + (let ((token (string-trim '(#\Space) (subseq text 6)))) + (send-daemon (list :type :event :payload + (list :action :hitl-respond :token token :decision :denied))) + (add-msg :system (format nil "✗ Denied: ~a" token)) + (resolve-hitl-panel :denied))) ;; /help command ;; /why command — show last gate trace ((string-equal text "/why") @@ -506,6 +508,17 @@ (input-insert-char chr) (setf (st :dirty) (list nil nil t)))))))) +;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny +(defun resolve-hitl-panel (decision) + "Mark the most recent HITL panel message as resolved with DECISION." + (loop for i from (1- (length (st :messages))) downto 0 + for m = (aref (st :messages) i) + when (and (getf m :panel) (not (getf m :panel-resolved))) + do (setf (getf m :panel-resolved) decision) + (setf (aref (st :messages) i) m) + (setf (st :dirty) (list nil t nil)) + (loop-finish))) + (defun on-daemon-msg (msg) (let* ((payload (getf msg :payload)) (text (getf payload :text)) @@ -996,18 +1009,33 @@ (fiveam:is (search "rm -rf" (getf m :content))))) (fiveam:test test-hitl-panel-after-approve - "Contract v0.7.2: /approve adds confirmation after panel." + "Contract v0.7.2: /approve adds confirmation and marks panel resolved." (init-state) (on-daemon-msg '(:type :EVENT :level :approval-required :payload (:sensor :approval-required :message "test"))) (dolist (ch (coerce "/approve HITL-test" 'list)) (on-key (char-code ch))) (on-key 13) + ;; Panel message (index 0) should be marked resolved (let ((m (aref (st :messages) 0))) - (fiveam:is (getf m :panel))) + (fiveam:is (getf m :panel)) + (fiveam:is (eq :approved (getf m :panel-resolved)))) + ;; Last message should be the approval confirmation (let ((m (aref (st :messages) (1- (length (st :messages)))))) (fiveam:is (search "Approved" (getf m :content))))) +(fiveam:test test-hitl-panel-after-deny + "Contract v0.7.2: /deny marks panel as denied." + (init-state) + (on-daemon-msg '(:type :EVENT :level :approval-required + :payload (:sensor :approval-required :message "blocked"))) + (dolist (ch (coerce "/deny HITL-deny" 'list)) + (on-key (char-code ch))) + (on-key 13) + (let ((m (aref (st :messages) 0))) + (fiveam:is (getf m :panel)) + (fiveam:is (eq :denied (getf m :panel-resolved))))) + (fiveam:test test-hitl-approve-parsed "Contract v0.7.2: /approve HITL-xxxx sends structured event, not raw text." (init-state) diff --git a/lisp/channel-tui-view.lisp b/lisp/channel-tui-view.lisp index 91edd6e..cdfcf9c 100644 --- a/lisp/channel-tui-view.lisp +++ b/lisp/channel-tui-view.lisp @@ -85,11 +85,14 @@ Returns list of trimmed strings. Single words wider than width are split." (color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent)))) (prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (is-panel (getf msg :panel)) + (is-resolved (getf msg :panel-resolved)) (line-text (format nil "~a [~a] ~a" prefix time content)) (wrapped (word-wrap line-text (- w 2)))) ;; HITL panel: render with colored border (when is-panel - (setf color (theme-color :hitl))) + (setf color (if is-resolved + (theme-color :dim) + (theme-color :hitl)))) (dolist (line wrapped) (when (< y (1- h)) (if (eq role :agent) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 92bfc29..7fa022a 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -159,16 +159,18 @@ Event handlers + daemon I/O + main loop. ;; /help command ((and (>= (length text) 9) (string-equal (subseq text 0 9) "/approve ")) - (let ((token (string-trim '(#\Space) (subseq text 9)))) - (send-daemon (list :type :event :payload - (list :action :hitl-respond :token token :decision :approved))) - (add-msg :system (format nil "Approved: ~a" token)))) + (let ((token (string-trim '(#\Space) (subseq text 9)))) + (send-daemon (list :type :event :payload + (list :action :hitl-respond :token token :decision :approved))) + (add-msg :system (format nil "✓ Approved: ~a" token)) + (resolve-hitl-panel :approved))) ((and (>= (length text) 6) (string-equal (subseq text 0 6) "/deny ")) - (let ((token (string-trim '(#\Space) (subseq text 6)))) - (send-daemon (list :type :event :payload - (list :action :hitl-respond :token token :decision :denied))) - (add-msg :system (format nil "Denied: ~a" token)))) + (let ((token (string-trim '(#\Space) (subseq text 6)))) + (send-daemon (list :type :event :payload + (list :action :hitl-respond :token token :decision :denied))) + (add-msg :system (format nil "✗ Denied: ~a" token)) + (resolve-hitl-panel :denied))) ;; /help command ;; /why command — show last gate trace ((string-equal text "/why") @@ -540,6 +542,17 @@ Event handlers + daemon I/O + main loop. (input-insert-char chr) (setf (st :dirty) (list nil nil t)))))))) +;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny +(defun resolve-hitl-panel (decision) + "Mark the most recent HITL panel message as resolved with DECISION." + (loop for i from (1- (length (st :messages))) downto 0 + for m = (aref (st :messages) i) + when (and (getf m :panel) (not (getf m :panel-resolved))) + do (setf (getf m :panel-resolved) decision) + (setf (aref (st :messages) i) m) + (setf (st :dirty) (list nil t nil)) + (loop-finish))) + (defun on-daemon-msg (msg) (let* ((payload (getf msg :payload)) (text (getf payload :text)) @@ -1043,18 +1056,33 @@ Event handlers + daemon I/O + main loop. (fiveam:is (search "rm -rf" (getf m :content))))) (fiveam:test test-hitl-panel-after-approve - "Contract v0.7.2: /approve adds confirmation after panel." + "Contract v0.7.2: /approve adds confirmation and marks panel resolved." (init-state) (on-daemon-msg '(:type :EVENT :level :approval-required :payload (:sensor :approval-required :message "test"))) (dolist (ch (coerce "/approve HITL-test" 'list)) (on-key (char-code ch))) (on-key 13) + ;; Panel message (index 0) should be marked resolved (let ((m (aref (st :messages) 0))) - (fiveam:is (getf m :panel))) + (fiveam:is (getf m :panel)) + (fiveam:is (eq :approved (getf m :panel-resolved)))) + ;; Last message should be the approval confirmation (let ((m (aref (st :messages) (1- (length (st :messages)))))) (fiveam:is (search "Approved" (getf m :content))))) +(fiveam:test test-hitl-panel-after-deny + "Contract v0.7.2: /deny marks panel as denied." + (init-state) + (on-daemon-msg '(:type :EVENT :level :approval-required + :payload (:sensor :approval-required :message "blocked"))) + (dolist (ch (coerce "/deny HITL-deny" 'list)) + (on-key (char-code ch))) + (on-key 13) + (let ((m (aref (st :messages) 0))) + (fiveam:is (getf m :panel)) + (fiveam:is (eq :denied (getf m :panel-resolved))))) + (fiveam:test test-hitl-approve-parsed "Contract v0.7.2: /approve HITL-xxxx sends structured event, not raw text." (init-state) diff --git a/org/channel-tui-view.org b/org/channel-tui-view.org index 11e37fe..3a6fef8 100644 --- a/org/channel-tui-view.org +++ b/org/channel-tui-view.org @@ -133,11 +133,14 @@ Returns list of trimmed strings. Single words wider than width are split." (color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent)))) (prefix (case role (:user "⬆") (:agent "⬇") (t " "))) (is-panel (getf msg :panel)) + (is-resolved (getf msg :panel-resolved)) (line-text (format nil "~a [~a] ~a" prefix time content)) (wrapped (word-wrap line-text (- w 2)))) ;; HITL panel: render with colored border (when is-panel - (setf color (theme-color :hitl))) + (setf color (if is-resolved + (theme-color :dim) + (theme-color :hitl)))) (dolist (line wrapped) (when (< y (1- h)) (if (eq role :agent)