Fix TUI display of sent messages
ober
6d0aadf75e18923e0414300e7ca4e137fc548f3f
--- a/Makefile +++ b/Makefile @@ -90,6 +90,9 @@ test: binary native-test-stage $(JEXEC) tests/test-send-result.ss $(JEXEC) tests/test-rpc-demux.ss $(JEXEC) tests/test-tui-send-async.ss + $(JEXEC) tests/test-tui-send-display.ss + $(JEXEC) tests/test-tui-send-full.ss + $(JEXEC) tests/test-tui-incoming-refresh.ss $(JEXEC) tests/test-bounded-line.ss $(JEXEC) tests/test-logdb-jsqlite.ss $(JEXEC) tests/test-logdb-crypto.ss --- a/signal/tui/main.ss +++ b/signal/tui/main.ss @@ -9,7 +9,34 @@ start-send-worker-with-call! notification->chat-event notification->line - terminal-display) + terminal-display + ;; Internal test helpers + make-initial-tui-state + ensure-conversation! + select-conversation! + handle-send-complete! + handle-send-events! + apply-chat-event! + conversation-messages + selected-conversation + conversation-id + make-chat-message + chat-message-text + chat-message-direction + chat-message-timestamp + chat-message-status + contact-canonical-target + contact-send-target + register-contact-aliases! + conversation-id-for + tui-state-send-events + tui-state-conversations + apply-actor-events! + append-pending-outbound! + compute-dirty-regions + thread-render-rows + thread-visible-layout + update-last-drawn!) (import (except (scheme) make-hash-table hash-table? @@ -433,56 +460,61 @@ (loop (cdr convs) (or changed? expired?)))])))) (def (handle-actor-events! state actor) - (let ([events (actor-take-events actor *max-actor-events-per-tick*)]) - (if (null? events) - #f - (begin - (tui-state-event-count-set! - state - (+ (tui-state-event-count state) (length events))) - (for-each - (lambda (ev) - (cond - [(and (pair? ev) (eq? (car ev) 'notification)) - (let* ([notif (cadr ev)] - [chat-event (notification->chat-event notif)]) - (when (and (tui-state-live-capture? state) - (tui-state-logdb state) - (loggable-chat-event? chat-event)) - (enqueue-capture-event! state (list 'notification notif))) - (if chat-event - (apply-chat-event! state chat-event) - (let ([line (notification->line notif)]) - (when line - (append-system-message! state line) - (tui-state-status-set! state "New Signal event received.")))) - (let ([saved (save-notification-attachments! notif)]) - (when (pair? saved) - (tui-state-status-set! - state - (string-append "Saved " - (number->string (length saved)) - (if (= (length saved) 1) " file to " - " files to ") - (download-base))))))] - [(and (pair? ev) (eq? (car ev) 'closed)) - (tui-state-status-set! - state - (string-append "signal-cli stream closed: " - (safe-display (cadr ev))))] - [(and (pair? ev) (eq? (car ev) 'error)) - (append-system-message! - state - (string-append "signal-cli error: " (safe-display (cadr ev)))) - (tui-state-status-set! state "signal-cli reported an error.")] - [(and (pair? ev) (eq? (car ev) 'stderr)) - (append-system-message! - state - (string-append "signal-cli: " (safe-display (cadr ev)))) - (tui-state-status-set! state "signal-cli reported a diagnostic.")] - [else (void)])) - events) - #t)))) + (apply-actor-events! + state + (actor-take-events actor *max-actor-events-per-tick*))) + + (def (apply-actor-events! state events) + (if (null? events) + #f + (begin + (tui-state-event-count-set! + state + (+ (tui-state-event-count state) (length events))) + (for-each + (lambda (ev) + (cond + [(and (pair? ev) (eq? (car ev) 'notification)) + (let* ([notif (cadr ev)] + [chat-event (notification->chat-event notif)]) + (when (and (tui-state-live-capture? state) + (tui-state-logdb state) + (loggable-chat-event? chat-event)) + (enqueue-capture-event! state (list 'notification notif))) + (if chat-event + (apply-chat-event! state chat-event) + (let ([line (notification->line notif)]) + (when line + (append-system-message! state line) + (tui-state-status-set! state "New Signal event received.")))) + (let ([saved (save-notification-attachments! notif)]) + (when (pair? saved) + (tui-state-status-set! + state + (string-append "Saved " + (number->string (length saved)) + (if (= (length saved) 1) " file to " + " files to ") + (download-base))))))] + [(and (pair? ev) (eq? (car ev) 'closed)) + (tui-state-status-set! + state + (string-append "signal-cli stream closed: " + (safe-display (cadr ev))))] + [(and (pair? ev) (eq? (car ev) 'error)) + (append-system-message! + state + (string-append "signal-cli error: " (safe-display (cadr ev)))) + (tui-state-status-set! state "signal-cli reported an error.")] + [(and (pair? ev) (eq? (car ev) 'stderr)) + (append-system-message! + state + (string-append "signal-cli: " (safe-display (cadr ev)))) + (tui-state-status-set! state "signal-cli reported a diagnostic.")] + [else (void)])) + events) + (force-next-redraw! state) + #t))) (def (loggable-chat-event? chat-event) (and (pair? chat-event) (eq? (car chat-event) 'message))) @@ -738,6 +770,7 @@ (append-system-message! state (string-append "Recreated missing conversation for send: " conv-id)) new-conv))]) + (void) (if (eq? (car outcome) 'sent) (handle-send-success! state kind conv conv-id display-text started (cdr outcome) success-status) @@ -748,22 +781,33 @@ started result success-status) (let ([ts (send-result-timestamp result)]) (when conv - (append-message-to-conversation! - conv - (make-chat-message 'out "You" display-text ts 'data 'sent)) + (let ([pending (find-pending-outbound + (conversation-messages conv) + display-text + started)]) + (if pending + (settle-pending-outbound! pending result) + (append-message-to-conversation! + conv + (make-chat-message 'out "You" display-text ts 'data 'sent)))) (clear-conversation-rate-limit! state conv) (conversation-unread-set! conv 0)) (tui-state-thread-scroll-set! state 0) + ;; Queue the outbound row for the capture worker. If the queue is full, + ;; log directly so sends are never lost; otherwise let the worker handle + ;; it once to avoid duplicate rows. (when (and (tui-state-live-capture? state) (tui-state-logdb state)) - (guard (_ [(condition? _) (void)]) - (capture-outbound! (tui-state-logdb state) (tui-state-account state) - conv-id display-text ts)) - (enqueue-capture-event! - state - (list 'outbound conv-id display-text ts))) + (let ([queued? (enqueue-capture-event! + state + (list 'outbound conv-id display-text ts))]) + (unless queued? + (guard (_ [(condition? _) (void)]) + (capture-outbound! (tui-state-logdb state) (tui-state-account state) + conv-id display-text ts))))) (when (eq? kind 'message) (tui-state-resend-set! state #f)) + (force-next-redraw! state) (trace-public-event! "tui-send-done" (list (cons 'ms (- (real-time) started)))) @@ -780,7 +824,10 @@ (when (and (eq? kind 'message) (string? resend-text)) (tui-state-resend-set! state resend-text)) (if conv - (report-send-failure! state conv e retry-hint) + (begin + (fail-pending-outbound! (conversation-messages conv) resend-text started) + (force-next-redraw! state) + (report-send-failure! state conv e retry-hint)) (begin (append-system-message! state @@ -805,28 +852,95 @@ (append-message-to-conversation! conv (make-chat-message 'system "system" line #f 'system #f)))) + (def (append-pending-outbound! state conv text started) + (append-message-to-conversation! + conv + (make-chat-message 'out "You" text started 'data 'sending)) + (conversation-unread-set! conv 0) + (tui-state-thread-scroll-set! state 0) + (force-next-redraw! state)) + + (def (find-pending-outbound messages text started) + (let loop ([ms (reverse messages)]) + (and (pair? ms) + (let ([msg (car ms)]) + (if (and (eq? (chat-message-direction msg) 'out) + (eq? (chat-message-status msg) 'sending) + (string=? (chat-message-text msg) text) + (number? (chat-message-timestamp msg)) + (= (chat-message-timestamp msg) started)) + msg + (loop (cdr ms))))))) + + (def (settle-pending-outbound! msg result) + (let ([ts (send-result-timestamp result)]) + (when ts + (chat-message-timestamp-set! msg ts)) + (chat-message-status-set! msg 'sent))) + (def (fail-pending-outbound! messages text started) + (let ([pending (find-pending-outbound messages text started)]) + (when pending + (chat-message-status-set! pending 'failed)))) (def (outbound-message-duplicate? existing new) (and (eq? (chat-message-direction existing) 'out) (eq? (chat-message-direction new) 'out) (string=? (chat-message-sender existing) (chat-message-sender new)) (string=? (chat-message-text existing) (chat-message-text new)) - (not (chat-message-timestamp existing)))) + (outbound-timestamp-duplicate? + (chat-message-timestamp existing) + (chat-message-timestamp new)))) -(def (merge-outbound-timestamps! existing new) + (def (merge-outbound-into! existing new) (when (and (not (chat-message-timestamp existing)) (chat-message-timestamp new)) - (chat-message-timestamp-set! existing (chat-message-timestamp new)))) -(def (append-message-to-conversation! conv msg) + (chat-message-timestamp-set! existing (chat-message-timestamp new))) + (let ([existing-status (chat-message-status existing)] + [new-status (chat-message-status new)]) + (when (and (not existing-status) new-status) + (chat-message-status-set! existing new-status)))) + + (def (outbound-timestamp-duplicate? existing-ts new-ts) + (cond + [(and (number? existing-ts) (number? new-ts)) + (= existing-ts new-ts)] + [(number? existing-ts) #t] + [(number? new-ts) #t] + ;; Both lack timestamps: assume the same optimistic/sync send. This can + ;; suppress an immediately repeated same-text send, but it prevents a + ;; sync without a timestamp from appearing as a duplicate. + [else #t])) + + (def (find-outbound-duplicate messages msg) + (and (eq? (chat-message-direction msg) 'out) + ;; A local send-complete has status 'sent. Always display it, even when + ;; signal-cli gives us no timestamp and the text matches the prior send. + (not (chat-message-status msg)) + (let ([new-ts (chat-message-timestamp msg)]) + (if (number? new-ts) + ;; A timestamped sync echo can match any earlier outbound with the + ;; same text/timestamp (or a placeholder without one). + (let loop ([ms (reverse messages)]) + (and (pair? ms) + (if (outbound-message-duplicate? (car ms) msg) + (car ms) + (loop (cdr ms))))) + ;; Without a timestamp, only merge a sync echo into the immediately + ;; preceding outbound; local sends are excluded above. + (and (pair? messages) + (outbound-message-duplicate? (last messages) msg) + (last messages)))))) + + (def (append-message-to-conversation! conv msg) (let* ([messages (conversation-messages conv)] [len (length messages)] [base (if (>= len 200) (drop-oldest messages (- len 199)) - messages)]) - (if (and (pair? base) - (outbound-message-duplicate? (last base) msg)) + messages)] + [dup (find-outbound-duplicate base msg)]) + (if dup (begin - (merge-outbound-timestamps! (last base) msg) + (merge-outbound-into! dup msg) (when (not (eq? base messages)) (conversation-messages-set! conv base))) (conversation-messages-set! conv (append base (list msg)))))) @@ -852,7 +966,10 @@ ;; A real message from them means they've stopped typing. (when (eq? (chat-message-direction msg) 'in) (conversation-typing-set! conv #f)) - (unless (selected-conversation? state id) + ;; Only incoming messages count as unread; our own sent/sync messages + ;; should not bump the badge on the conversation we just wrote to. + (when (and (eq? (chat-message-direction msg) 'in) + (not (selected-conversation? state id))) (conversation-unread-set! conv (+ (conversation-unread conv) 1))) ;; Reset scroll to newest messages when we receive a message in the ;; currently visible conversation. @@ -1385,6 +1502,8 @@ [(eq? status 'read) " read"] [(eq? status 'delivered) " delivered"] [(eq? status 'sent) " sent"] + [(eq? status 'sending) " sending"] + [(eq? status 'failed) " failed"] [else ""])) (def *sender-color-faces* @@ -1715,6 +1834,7 @@ ;; error (partial/multi-device failures), so Enter must never re-fire ;; the same text. On failure the text is stashed for Ctrl-R. (tui-state-input-set! state "") + (append-pending-outbound! state conv text started) (tui-state-status-set! state "Sending...") (start-send-worker! state actor 'message (conversation-id conv) @@ -2610,6 +2730,8 @@ (loop (cdr convs) (cons (cons (conversation-id conv) (conversation-unread conv)) acc)))]))) + (def (force-next-redraw! state) + (tui-state-last-drawn-set! state (make-hashtable equal-hash equal?))) ;; --- Drawing --- @@ -2996,26 +3118,25 @@ [reserved (if typing 1 0)] [rows (max 0 (- height 3 reserved))] [scroll (tui-state-thread-scroll state)] - [rendered (thread-render-rows (conversation-messages conv) - width - rows - scroll)] - [max-scroll (max-thread-scroll conv width rows)] - [more-below? (< scroll max-scroll)] - [msg-rows (- rows (if more-below? 1 0))]) - (when (> scroll 0) + [layout (thread-visible-layout conv width rows scroll)] + [more-above? (list-ref layout 0)] + [more-below? (list-ref layout 1)] + [rendered (list-ref layout 2)] + [bottom-row (+ y height -1)]) + (when more-above? (draw-text! x (+ y 3) width (fg-dim) (bg) "^")) - (let loop ([rs rendered] [row (+ y 3 (if (> scroll 0) 1 0))]) - (if (and (pair? rs) (< row (+ y 3 msg-rows))) + (let loop ([rs rendered] + [row (+ y 3 (if more-above? 1 0))]) + (if (pair? rs) (begin (draw-text! x row width (chat-message-fg (caar rs)) (bg) (cdar rs)) (loop (cdr rs) (+ row 1))) - (when (and typing (< row (+ y height -1))) + (when (and typing (< row (if more-below? bottom-row (+ y height)))) (draw-text! x row width (fg-dim) (bg) (string-append typing " is typing..."))))) (when more-below? - (draw-text! x (+ y height -1) width (fg-dim) (bg) "v")))) + (draw-text! x bottom-row width (fg-dim) (bg) "v")))) (begin (draw-text! x y width (fg-strong) (bg) "jerboa-signal") (draw-text! x (+ y 1) width (fg-dim) (bg) @@ -3055,6 +3176,21 @@ ;; Clamp scroll so the visible bottom never goes above the first row. (def (max-thread-scroll conv width height) (max 0 (- (total-thread-rows conv width) height))) + (def (thread-visible-layout conv width rows scroll) + (let* ([total (total-thread-rows conv width)] + [more-below? (> scroll 0)] + [usable-after-below (max 0 (- rows (if more-below? 1 0)))] + [more-above? (< (+ scroll usable-after-below) total)] + [msg-rows (max 0 + (- rows + (if more-above? 1 0) + (if more-below? 1 0)))] + [rendered (thread-render-rows + (conversation-messages conv) + width + msg-rows + scroll)]) + (list more-above? more-below? rendered))) ;; Scroll the thread. Positive delta means show older messages. (def (scroll-thread! state delta) new file mode 100644 --- /dev/null +++ b/tests/test-tui-incoming-refresh.ss @@ -0,0 +1,70 @@ +#!chezscheme +;;; Regression test: actor receive events must repaint the visible thread without +;;; waiting for a keyboard event or conversation switch. + +(import (except (scheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (signal tui main)) + +(def (check label pred) + (unless pred + (error 'test-tui-incoming-refresh label))) + +(def (ht . kvs) + (let ([h (make-hashtable equal-hash equal?)]) + (let loop ([xs kvs]) + (unless (null? xs) + (hashtable-set! h (car xs) (cadr xs)) + (loop (cddr xs)))) + h)) + +(def (receive-notification text) + (ht "jsonrpc" "2.0" + "method" "receive" + "params" (ht "subscription" 0 + "result" (ht "account" "+15550000" + "envelope" + (ht "sourceUuid" + "aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee" + "sourceName" "Alice" + "sourceDevice" 1 + "timestamp" 1000 + "dataMessage" + (ht "timestamp" 1000 + "message" text)))))) + +(let ([state (make-initial-tui-state "test" "test" "manual" 80 24 + #f (make-hashtable equal-hash equal?))]) + (ensure-conversation! state + "direct:aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee" + "Alice" + 'direct + "aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee") + (select-conversation! state 1) + ;; Simulate a completed draw snapshot before the receive event arrives. + (update-last-drawn! state) + (check "selected thread initially empty" + (= (length (conversation-messages (selected-conversation state))) 0)) + (check "actor event batch reports dirty" + (apply-actor-events! + state + (list (list 'notification (receive-notification "live hello"))))) + (let ([messages (conversation-messages (selected-conversation state))] + [dirty (compute-dirty-regions state)]) + (check "incoming actor event appends to selected thread" + (= (length messages) 1)) + (check "incoming actor event preserves text" + (string=? (chat-message-text (car messages)) "live hello")) + (check "incoming actor event forces full redraw without keypress" + (memq 'all dirty)))) + +(display "tui incoming refresh ok") +(newline) new file mode 100644 --- /dev/null +++ b/tests/test-tui-send-display.ss @@ -0,0 +1,167 @@ +#!chezscheme +;;; Focused test that sent messages actually land in the conversation. + +(import (except (scheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (signal tui main)) + +(def (check label pred) + (unless pred + (error 'test-tui-send-display label))) + +(def (ht . kvs) + (let ([h (make-hashtable equal-hash equal?)]) + (let loop ([xs kvs]) + (unless (null? xs) + (hashtable-set! h (car xs) (cadr xs)) + (loop (cddr xs)))) + h)) + +(def (success-result ts) + (let ([h (ht "timestamp" ts + "results" (list (ht "type" "SUCCESS")))]) + (cons 'sent h))) + +(def (rendered-texts conv) + (map cdr (list-ref (thread-visible-layout conv 60 20 0) 2))) + +(def (rendered-contains? conv needle) + (let loop ([rows (rendered-texts conv)]) + (and (pair? rows) + (or (string-contains (car rows) needle) + (loop (cdr rows)))))) + +(let ([state (make-initial-tui-state "test" "test" "manual" 80 24 + #f (make-hashtable equal-hash equal?))]) + (ensure-conversation! state "direct:+15550001" "Alice" 'direct "+15550001") + (select-conversation! state 1) + + ;; First send with timestamp. + (handle-send-complete! + state + (list 'send-complete 'message "direct:+15550001" + "hello" "hello" (real-time) + (success-result 1234) "" "Sent.")) + + (let ([msgs (conversation-messages (selected-conversation state))]) + (check "first send adds one message" (= (length msgs) 1)) + (check "first send text preserved" + (string=? (chat-message-text (car msgs)) "hello")) + (check "first send direction outbound" + (eq? (chat-message-direction (car msgs)) 'out))) + + ;; Second send with same text but different timestamp. + (handle-send-complete! + state + (list 'send-complete 'message "direct:+15550001" + "hello" "hello" (real-time) + (success-result 1235) "" "Sent.")) + + (let ([msgs (conversation-messages (selected-conversation state))]) + (check "same text different timestamp is not deduped" + (= (length msgs) 2))) + + ;; Sync notification for the first send should dedupe by timestamp. + (apply-chat-event! + state + (list 'message "direct:+15550001" "Alice" 'direct "+15550001" + (make-chat-message 'out "You" "hello" 1234 'data #f))) + + (let ([msgs (conversation-messages (selected-conversation state))]) + (check "sync with matching timestamp does not duplicate" + (= (length msgs) 2))) + + ;; Send with no timestamp, then same text again with no timestamp. + (handle-send-complete! + state + (list 'send-complete 'message "direct:+15550001" + "notimestamp" "notimestamp" (real-time) + (cons 'sent (ht "results" (list (ht "type" "SUCCESS")))) "" "Sent.")) + + (let ([msgs (conversation-messages (selected-conversation state))]) + (check "no-timestamp send adds message" (= (length msgs) 3))) + + (handle-send-complete! + state + (list 'send-complete 'message "direct:+15550001" + "notimestamp" "notimestamp" (real-time) + (cons 'sent (ht "results" (list (ht "type" "SUCCESS")))) "" "Sent.")) + + (let ([msgs (conversation-messages (selected-conversation state))] + [dirty (compute-dirty-regions state)]) + (check "same no-timestamp text is displayed for each local send" + (= (length msgs) 4)) + (check "local send-complete forces redraw" + (memq 'all dirty)))) + +(let* ([state (make-initial-tui-state "test" "test" "manual" 80 24 + #f (make-hashtable equal-hash equal?))] + [conv (ensure-conversation! state "direct:+15550002" + "Bob" 'direct "+15550002")] + [first-start 2001] + [second-start 2002]) + (select-conversation! state 1) + (update-last-drawn! state) + (append-pending-outbound! state conv "again" first-start) + (append-pending-outbound! state conv "again" second-start) + (let ([msgs (conversation-messages (selected-conversation state))] + [dirty (compute-dirty-regions state)]) + (check "two same-text pending local sends are visible immediately" + (= (length msgs) 2)) + (check "pending local send forces redraw" + (memq 'all dirty)) + (check "first pending row marked sending" + (eq? (chat-message-status (car msgs)) 'sending)) + (check "second pending row marked sending" + (eq? (chat-message-status (cadr msgs)) 'sending)) + (check "rendered rows include pending text" + (rendered-contains? (selected-conversation state) "again")) + (check "rendered rows include sending status" + (rendered-contains? (selected-conversation state) "sending"))) + (handle-send-complete! + state + (list 'send-complete 'message "direct:+15550002" + "again" "again" first-start + (cons 'sent (ht "results" (list (ht "type" "SUCCESS")))) "" "Sent.")) + (handle-send-complete! + state + (list 'send-complete 'message "direct:+15550002" + "again" "again" second-start + (cons 'sent (ht "results" (list (ht "type" "SUCCESS")))) "" "Sent.")) + (let ([msgs (conversation-messages (selected-conversation state))]) + (check "send-complete settles pending rows without duplicating" + (= (length msgs) 2)) + (check "first pending row settled" + (eq? (chat-message-status (car msgs)) 'sent)) + (check "second pending row settled" + (eq? (chat-message-status (cadr msgs)) 'sent)))) +(let* ([state (make-initial-tui-state "test" "test" "manual" 80 24 + #f (make-hashtable equal-hash equal?))] + [conv (ensure-conversation! state "direct:+15550003" + "Carol" 'direct "+15550003")]) + (select-conversation! state 1) + (append-pending-outbound! state conv "old-1" 3001) + (append-pending-outbound! state conv "old-2" 3002) + (append-pending-outbound! state conv "old-3" 3003) + (append-pending-outbound! state conv "newest-visible" 3004) + (let* ([layout (thread-visible-layout conv 60 3 0)] + [rows (map cdr (list-ref layout 2))]) + (check "bottom overflow shows older-message marker" + (list-ref layout 0)) + (check "bottom overflow has no newer-message marker" + (not (list-ref layout 1))) + (check "newest pending send is visible in overflow" + (let loop ([xs rows]) + (and (pair? xs) + (or (string-contains (car xs) "newest-visible") + (loop (cdr xs)))))))) +(display "tui send display ok") +(newline) new file mode 100644 --- /dev/null +++ b/tests/test-tui-send-full.ss @@ -0,0 +1,94 @@ +#!chezscheme +;;; Integration test: full send flow through the TUI. +;;; Exercises the path from send-complete event to message appearing +;;; in the selected conversation, including alias interactions. + +(import (except (scheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (std csp) + (signal tui main) + (signal send-result)) + +(def (check label pred) + (unless pred + (error 'test-tui-send-full label))) + +(def (ht . kvs) + (let ([h (make-hashtable equal-hash equal?)]) + (let loop ([xs kvs]) + (unless (null? xs) + (hashtable-set! h (car xs) (cadr xs)) + (loop (cddr xs)))) + h)) + +(def (success-result ts) + (let ([h (ht "timestamp" ts + "results" (list (ht "type" "SUCCESS")))]) + (cons 'sent h))) + +;; Test 1: Normal path with a UUID-based contact (contact seeded then send). +(let* ([state (make-initial-tui-state "test" "test" "manual" 80 24 + #f (make-hashtable equal-hash equal?))] + [uuid "aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee"] + [phone "+15550001"] + [contact (ht "uuid" uuid "number" phone "name" "Alice")] + [canonical-target (contact-canonical-target contact)] + [send-target (contact-send-target contact canonical-target)] + [conv-id (conversation-id-for 'direct canonical-target canonical-target)] + [_ (register-contact-aliases! state contact canonical-target)] + [conv (ensure-conversation! state conv-id "Alice" 'direct send-target)] + [_ (select-conversation! state 1)] + [conv (selected-conversation state)] + [events (tui-state-send-events state)] + [_ (chan-put! events + (list 'send-complete 'message (conversation-id conv) + "hello" "hello" (real-time) + (success-result 1001) "" "Sent."))] + [_ (handle-send-events! state)] + [msgs (conversation-messages (selected-conversation state))]) + (check "test1: selected conversation has messages" (pair? msgs)) + (check "test1: text correct" (string=? (chat-message-text (car msgs)) "hello")) + (check "test1: direction outbound" (eq? (chat-message-direction (car msgs)) 'out))) + +;; Test 2: Phone-number conversation created before aliases exist. +;; This crashed when canonicalization was added to handle-send-complete!. +(let* ([state (make-initial-tui-state "test" "test" "manual" 80 24 + #f (make-hashtable equal-hash equal?))] + [phone "+15550002"] + [uuid "ffffffff-gggg-hhhh-iiii-jjjjjjjjjjjj"] + [phone-id (conversation-id-for 'direct phone phone)] + [conv (ensure-conversation! state phone-id "Bob" 'direct phone)] + [conv-id-before (conversation-id conv)] + [_ (select-conversation! state 1)] + ;; Aliases registered AFTER conversation exists (contact load) + [_ (register-contact-aliases! state + (ht "uuid" uuid "number" phone "name" "Bob") + uuid)] + [events (tui-state-send-events state)] + [conv (selected-conversation state)] + [conv-id-send (conversation-id conv)] + [_ (chan-put! events + (list 'send-complete 'message (conversation-id conv) + "hi" "hi" (real-time) + (success-result 1002) "" "Sent."))] + [_ (handle-send-events! state)] + [msgs (conversation-messages (selected-conversation state))] + [all-convs (tui-state-conversations state)]) + (check "test2: conv id unchanged after aliases" + (string=? conv-id-before conv-id-send)) + (check "test2: selected conversation has message" (pair? msgs)) + (check "test2: message text correct" (string=? (chat-message-text (car msgs)) "hi")) + ;; Exactly 2 conversations: system + Bob (no duplicate created by send) + (check "test2: no duplicate conversation created" + (= (length all-convs) 2))) + +(display "tui send full ok") +(newline) \ No newline at end of file