Handle current receive notification shapes
ober
718d2875646baaf06fadc8b4e7be97292d78652c
--- a/Makefile +++ b/Makefile @@ -55,6 +55,7 @@ run-tui: binary tui-shim test: binary $(JEXEC) tests/test-send-result.ss + $(JEXEC) tests/test-receive-normalization.ss ./$(BIN) --help >/dev/null && echo "smoke ok" install: binary --- a/signal/capture.ss +++ b/signal/capture.ss @@ -67,15 +67,19 @@ (def (envelope->row env) (let ([data (htref env "dataMessage")] + [edit (htref env "editMessage")] + [story (htref env "storyMessage")] [sync (htref env "syncMessage")] [receipt (htref env "receiptMessage")] [typing (htref env "typingMessage")] [call (htref env "callMessage")] [src-name (first-string (htref env "sourceName") (htref env "sourceNumber") + (htref env "sourceUuid") (htref env "source") "unknown")] [src-target (first-string (htref env "sourceNumber") + (htref env "sourceUuid") (htref env "source"))] [env-ts (htref env "timestamp")]) (cond @@ -87,20 +91,46 @@ (or (htref data "timestamp") env-ts) (data-kind data) (or (nonempty (htref data "message")) (body-marker data))))] + [(hashtable? edit) + (let ([nested (htref edit "dataMessage")]) + (if (hashtable? nested) + (let ([gid (data-group-id nested)]) + (list "in" + (conv-id gid (or gid src-target src-name)) + src-name + (or (htref edit "targetSentTimestamp") + (htref nested "timestamp") + env-ts) + "edit" + (edit-body edit))) + (list "in" (conv-id #f (or src-target src-name)) src-name + env-ts "edit" "[edited message]")))] + [(hashtable? story) + (story-row "in" story src-name src-target env-ts)] [(hashtable? sync) (let ([sent (htref sync "sentMessage")]) - (if (hashtable? sent) - (let ([gid (data-group-id sent)] - [dest (first-string (htref sent "destinationNumber") - (htref sent "destination") - (htref sent "destinationUuid"))]) - (list "out" - (conv-id gid (or gid dest "unknown")) - "You" - (or (htref sent "timestamp") env-ts) - (data-kind sent) - (or (nonempty (htref sent "message")) (body-marker sent)))) - (list "out" "" "You" env-ts "sync" "")))] + (cond + [(hashtable? sent) + (let ([gid (data-group-id sent)] + [dest (first-string (htref sent "destinationNumber") + (htref sent "destination") + (htref sent "destinationUuid"))]) + (list "out" + (conv-id gid (or gid dest "unknown")) + "You" + (or (htref sent "timestamp") env-ts) + (data-kind sent) + (or (nonempty (htref sent "message")) (body-marker sent))))] + [(hashtable? (htref sync "sentStoryMessage")) + (let* ([sent-story (htref sync "sentStoryMessage")] + [story (htref sent-story "dataMessage")]) + (if (hashtable? story) + (story-row "out" story "You" + (first-string (htref sent-story "destinationNumber") + (htref sent-story "destinationUuid")) + env-ts) + (list "out" "" "You" env-ts "sync" "")))] + [else (list "out" "" "You" env-ts "sync" "")]))] [(hashtable? receipt) (list "in" (conv-id #f (or src-target src-name)) src-name env-ts "receipt" "")] [(hashtable? typing) @@ -129,7 +159,9 @@ (and (htref msg "sticker") "[sticker]") (and (nonempty-list? (htref msg "attachments")) "[attachment]") (and (nonempty-list? (htref msg "contacts")) "[contact]") - (and (nonempty-list? (htref msg "preview")) "[link preview]") + (and (or (nonempty-list? (htref msg "preview")) + (nonempty-list? (htref msg "previews"))) + "[link preview]") "")) (def (edit-body edit) @@ -170,6 +202,23 @@ (string-append (if gid "group:" "direct:") (safe-display (or target "unknown")))) + (def (story-row direction story sender target ts) + (let ([gid (nonempty (htref story "groupId"))]) + (list direction + (conv-id gid (or gid target sender)) + sender + ts + "data" + (story-body story)))) + + (def (story-body story) + (let ([text-attachment (htref story "textAttachment")] + [file-attachment (htref story "fileAttachment")]) + (or (and (hashtable? text-attachment) + (nonempty (htref text-attachment "text"))) + (and (hashtable? file-attachment) "[story attachment]") + "[story]"))) + (def (data-group-id msg) (or (nonempty (htref msg "groupId")) (let ([gi (htref msg "groupInfo")]) --- a/signal/log_shim.c +++ b/signal/log_shim.c @@ -141,9 +141,7 @@ void *signal_log_recent(void *handle, long long limit) { static const char *SQL = "SELECT direction, conversation, sender, timestamp, kind, body" " FROM messages" - " WHERE kind IN ('data','edit','reaction','remote-delete','sticker'," - " 'contact','preview','attachment','call')" - " AND direction IN ('in','out')" + " WHERE direction IN ('in','out')" " AND conversation IS NOT NULL AND conversation <> ''" " AND body IS NOT NULL AND body <> ''" " ORDER BY id DESC LIMIT ?;"; --- a/signal/logdb.ss +++ b/signal/logdb.ss @@ -142,7 +142,7 @@ "INSERT INTO messages (logged_at,account,direction,conversation,sender,timestamp,kind,body,raw) VALUES (?,?,?,?,?,?,?,?,?)") (def *recent-sql* - "SELECT direction, conversation, sender, timestamp, kind, body FROM messages WHERE kind IN ('data','edit','reaction','remote-delete','sticker','contact','preview','attachment','call') AND direction IN ('in','out') AND conversation IS NOT NULL AND conversation <> '' AND body IS NOT NULL AND body <> '' ORDER BY id DESC LIMIT ?") + "SELECT direction, conversation, sender, timestamp, kind, body FROM messages WHERE direction IN ('in','out') AND conversation IS NOT NULL AND conversation <> '' AND body IS NOT NULL AND body <> '' ORDER BY id DESC LIMIT ?") (def (now-seconds) (time-second (current-time))) --- a/signal/tui/main.ss +++ b/signal/tui/main.ss @@ -4,7 +4,8 @@ (library (signal tui main) (export run-tui-terminal run-tui-terminal-with-logdb - open-tui-message-log) + open-tui-message-log + notification->chat-event) (import (except (chezscheme) make-hash-table hash-table? @@ -2311,6 +2312,8 @@ (def (envelope->chat-event account envelope) (let ([data (hashtable-ref envelope "dataMessage" #f)] + [edit (hashtable-ref envelope "editMessage" #f)] + [story (hashtable-ref envelope "storyMessage" #f)] [sync (hashtable-ref envelope "syncMessage" #f)] [receipt (hashtable-ref envelope "receiptMessage" #f)] [typing (hashtable-ref envelope "typingMessage" #f)] @@ -2318,6 +2321,10 @@ (cond [(hashtable? data) (data-message->chat-event account envelope data)] + [(hashtable? edit) + (edit-message->chat-event account envelope edit)] + [(hashtable? story) + (story-message->chat-event envelope story 'in)] [(hashtable? sync) (sync-message->chat-event account envelope sync)] [(hashtable? receipt) @@ -2348,27 +2355,72 @@ (message-kind-symbol data) #f)]) (list 'message id title kind target msg))) + (def (edit-message->chat-event account envelope edit) + (let ([data (hashtable-ref edit "dataMessage" #f)]) + (if (hashtable? data) + (let* ([event (data-message->chat-event account envelope data)] + [msg (list-ref event 5)]) + (chat-message-kind-set! msg 'edit) + (chat-message-text-set! + msg + (let ([body (message-text data)]) + (if (non-empty-string? body) + (string-append "[edited] " body) + "[edited message]"))) + (let ([target-ts (hashtable-ref edit "targetSentTimestamp" #f)]) + (when (number? target-ts) + (chat-message-timestamp-set! msg target-ts))) + event) + (cons 'message + (simple-envelope-event envelope "[edited message]" 'edit))))) + + (def (story-message->chat-event envelope story direction) + (let* ([group-target (first-non-empty-string + (hashtable-ref story "groupId" #f))] + [source-title (envelope-source-title envelope)] + [source-target (envelope-source-target envelope)] + [kind (if group-target 'group 'direct)] + [target (if group-target group-target source-target)] + [title (if group-target + (string-append "Group " (short-id group-target)) + source-title)] + [id (conversation-id-for kind target source-title)] + [text (story-message-text story)] + [timestamp (hashtable-ref envelope "timestamp" #f)] + [msg (make-chat-message direction + (if (eq? direction 'out) "You" source-title) + text timestamp 'story #f)]) + (list 'message id title kind target msg))) + (def (sync-message->chat-event account envelope sync) - (let ([sent (hashtable-ref sync "sentMessage" #f)]) - (and (hashtable? sent) - (let* ([group-target (message-group-id sent)] - [dest (or (hashtable-ref sent "destinationNumber" #f) - (hashtable-ref sent "destinationUuid" #f) - (hashtable-ref sent "destination" #f) - "unknown")] - [kind (if group-target 'group 'direct)] - [target (if group-target group-target - (if (non-empty-string? dest) dest #f))] - [title (if group-target - (message-group-title sent group-target) - dest)] - [id (conversation-id-for kind target title)] - [text (message-text sent)] - [timestamp (or (hashtable-ref sent "timestamp" #f) - (hashtable-ref envelope "timestamp" #f))] - [msg (make-chat-message 'out "You" text timestamp - (message-kind-symbol sent) #f)]) - (list 'message id title kind target msg))))) + (let ([sent (hashtable-ref sync "sentMessage" #f)] + [sent-story (hashtable-ref sync "sentStoryMessage" #f)]) + (cond + [(hashtable? sent) + (let* ([group-target (message-group-id sent)] + [dest (first-non-empty-string + (hashtable-ref sent "destinationNumber" #f) + (hashtable-ref sent "destinationUuid" #f) + (hashtable-ref sent "destination" #f) + "unknown")] + [kind (if group-target 'group 'direct)] + [target (if group-target group-target + (if (non-empty-string? dest) dest #f))] + [title (if group-target + (message-group-title sent group-target) + dest)] + [id (conversation-id-for kind target title)] + [text (message-text sent)] + [timestamp (or (hashtable-ref sent "timestamp" #f) + (hashtable-ref envelope "timestamp" #f))] + [msg (make-chat-message 'out "You" text timestamp + (message-kind-symbol sent) #f)]) + (list 'message id title kind target msg))] + [(hashtable? sent-story) + (let ([story (hashtable-ref sent-story "dataMessage" #f)]) + (and (hashtable? story) + (story-message->chat-event envelope story 'out)))] + [else #f]))) (def (simple-envelope-event envelope text kind) (let* ([source-title (envelope-source-title envelope)] @@ -2413,11 +2465,13 @@ (def (envelope-source-title envelope) (or (hashtable-ref envelope "sourceName" #f) (hashtable-ref envelope "sourceNumber" #f) + (hashtable-ref envelope "sourceUuid" #f) (hashtable-ref envelope "source" #f) "unknown")) (def (envelope-source-target envelope) (let ([target (or (hashtable-ref envelope "sourceNumber" #f) + (hashtable-ref envelope "sourceUuid" #f) (hashtable-ref envelope "source" #f) #f)]) (and (non-empty-string? target) @@ -2443,10 +2497,21 @@ [(and (hashtable? msg) (hashtable-ref msg "reaction" #f)) 'reaction] [(and (hashtable? msg) (hashtable-ref msg "sticker" #f)) 'sticker] [(and (hashtable? msg) (nonempty-list? (hashtable-ref msg "contacts" #f))) 'contact] - [(and (hashtable? msg) (nonempty-list? (hashtable-ref msg "preview" #f))) 'preview] + [(and (hashtable? msg) + (or (nonempty-list? (hashtable-ref msg "preview" #f)) + (nonempty-list? (hashtable-ref msg "previews" #f)))) 'preview] [(and (hashtable? msg) (nonempty-list? (hashtable-ref msg "attachments" #f))) 'attachment] [else 'data])) + (def (story-message-text story) + (let ([text-attachment (hashtable-ref story "textAttachment" #f)] + [file-attachment (hashtable-ref story "fileAttachment" #f)]) + (or (and (hashtable? text-attachment) + (first-non-empty-string + (hashtable-ref text-attachment "text" #f))) + (and (hashtable? file-attachment) "[story attachment]") + "[story]"))) + (def (edit-message-text edit) (and (hashtable? edit) (let* ([nested (or (hashtable-ref edit "dataMessage" #f) @@ -2514,9 +2579,11 @@ (def (message-group-title msg fallback) (let ([group-info (hashtable-ref msg "groupInfo" #f)]) (if (hashtable? group-info) - (or (hashtable-ref group-info "name" #f) - (hashtable-ref group-info "title" #f) - (string-append "Group " (safe-display fallback))) + (or (first-non-empty-string + (hashtable-ref group-info "groupName" #f) + (hashtable-ref group-info "name" #f) + (hashtable-ref group-info "title" #f)) + (string-append "Group " (short-id fallback))) (string-append "Group " (safe-display fallback))))) (def (notification->line notif) new file mode 100644 --- /dev/null +++ b/tests/test-receive-normalization.ss @@ -0,0 +1,147 @@ +#!chezscheme +;;; Focused tests for signal-cli receive notification normalization. + +(import (except (chezscheme) + 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) + (signal capture) + (signal logdb)) + +(def path "/tmp/jerboa-signal-receive-normalization.db") + +(def (delete-if-exists! p) + (when (file-exists? p) (delete-file p))) + +(def (check label pred) + (unless pred + (error 'test-receive-normalization 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 (notif envelope) + (ht "jsonrpc" "2.0" + "method" "receive" + "params" (ht "subscription" 0 + "result" (ht "account" "+15550000" + "envelope" envelope)))) + +(def direct-uuid + (notif + (ht "sourceUuid" "aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee" + "sourceName" "Alice" + "sourceDevice" 1 + "timestamp" 1000 + "dataMessage" (ht "timestamp" 1000 + "message" "hello")))) + +(def group-current + (notif + (ht "sourceUuid" "bbbbbbbb-cccc-dddd-eeee-ffffffffffff" + "sourceName" "Bob" + "sourceDevice" 1 + "timestamp" 2000 + "dataMessage" (ht "timestamp" 2000 + "message" "group hello" + "groupInfo" (ht "groupId" "GROUPID" + "groupName" "Ops"))))) + +(def top-level-edit + (notif + (ht "sourceUuid" "cccccccc-dddd-eeee-ffff-000000000000" + "sourceName" "Carol" + "timestamp" 3000 + "editMessage" (ht "targetSentTimestamp" 2500 + "dataMessage" (ht "timestamp" 3000 + "message" "edited body"))))) + +(def group-story + (notif + (ht "sourceUuid" "dddddddd-eeee-ffff-0000-111111111111" + "sourceName" "Dana" + "timestamp" 4000 + "storyMessage" (ht "groupId" "STORYGROUP" + "textAttachment" (ht "text" "story text"))))) + +(let ([event (notification->chat-event direct-uuid)]) + (check "direct sourceUuid promoted to chat event" + (and (list? event) (eq? (car event) 'message))) + (check "direct sourceUuid used as stable id" + (string=? (list-ref event 1) + "direct:aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee")) + (check "direct target is sourceUuid" + (string=? (list-ref event 4) + "aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee"))) + +(let ([event (notification->chat-event group-current)]) + (check "group notification promoted" + (and (list? event) (eq? (car event) 'message))) + (check "group id found from groupInfo" + (string=? (list-ref event 1) "group:GROUPID")) + (check "groupName used as title" + (string=? (list-ref event 2) "Ops"))) + +(let ([event (notification->chat-event top-level-edit)]) + (check "top-level edit promoted" + (and (list? event) (eq? (car event) 'message))) + (check "top-level edit keeps sourceUuid conversation" + (string=? (list-ref event 1) + "direct:cccccccc-dddd-eeee-ffff-000000000000"))) + +(let ([event (notification->chat-event group-story)]) + (check "story promoted" + (and (list? event) (eq? (car event) 'message))) + (check "story group id used" + (string=? (list-ref event 1) "group:STORYGROUP"))) + +(delete-if-exists! path) +(delete-if-exists! (string-append path ".tmp")) + +(let ([h (logdb-open path "normalization key")]) + (check "open normalization log" h) + (capture-notification! h "+15550000" direct-uuid) + (capture-notification! h "+15550000" group-current) + (capture-notification! h "+15550000" top-level-edit) + (capture-notification! h "+15550000" group-story) + (let ([rows (logdb-recent h 10)]) + (check "four displayable rows captured" (= (length rows) 4)) + (check "story captured as displayable row" + (member (list "in" "group:STORYGROUP" "Dana" 4000 + "data" "story text") + rows)) + (check "edit captured as displayable row" + (member (list "in" + "direct:cccccccc-dddd-eeee-ffff-000000000000" + "Carol" + 2500 + "edit" + "[edited] edited body") + rows)) + (check "sourceUuid captured as direct conversation" + (member (list "in" + "direct:aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee" + "Alice" + 1000 + "data" + "hello") + rows))) + (logdb-close h)) + +(delete-if-exists! path) +(delete-if-exists! (string-append path ".tmp")) + +(display "receive normalization ok") +(newline)