* mumi/client.scm: Import (srfi srfi-1).
(reply-email-headers): New function.
(send-email): Call reply-email-headers.
* tests/client.scm ("send patches to existing issue", "send single
patch to existing issue"): Stub reply-email-headers.
("send patch to existing issue and Cc other participants"): New test.
---
mumi/client.scm | 36 ++++++++++++++++++++++++++++++++----
tests/client.scm | 25 +++++++++++++++++++++++++
2 files changed, 57 insertions(+), 4 deletions(-)
Toggle diff (104 lines)
diff --git a/mumi/client.scm b/mumi/client.scm
index 2750836..7ba47e6 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -18,6 +18,7 @@
(define-module (mumi client)
#:use-module (rnrs io ports)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-43)
@@ -236,15 +237,42 @@ OPTIONS. Return the message ID of the first email sent."
(display (get-string-all port))
message-id)))))
+(define (reply-email-headers issue-number)
+ "Return an association list of email headers when replying to
+ISSUE-NUMBER."
+ (let ((messages
+ (assoc-ref
+ (assoc-ref
+ (graphql-http-get (graphql-endpoint)
+ `(document
+ (query (#(issue #:number ,issue-number)
+ (messages (from name address)
+ date)))))
+ "issue")
+ "messages")))
+ ;; When sending email to an issue, we Cc all issue participants.
+ ;; TODO: Also add an In-Reply-To header.
+ `((x-debbugs-cc
+ . ,(delete-duplicates
+ (map (lambda (message)
+ (let ((from (assoc-ref message "from")))
+ (string-append (assoc-ref from "name")
+ " <" (assoc-ref from "address") ">")))
+ (vector->list messages)))))))
+
(define (send-email patches)
"Send PATCHES via email."
(if (current-issue-number)
;; If an issue is current, send patches to that issue's email
;; address.
- (git-send-email (string-append (number->string (current-issue-number))
- "@"
- (client-config 'debbugs-host))
- patches)
+ (let ((issue-number (current-issue-number)))
+ (git-send-email (string-append (number->string issue-number)
+ "@"
+ (client-config 'debbugs-host))
+ patches
+ (map (cut string-append "--add-header=X-Debbugs-Cc: " <>)
+ (assq-ref (reply-email-headers issue-number)
+ 'x-debbugs-cc))))
(match patches
;; If it's a single patch, send it to the patch email address
;; and be done with it
diff --git a/tests/client.scm b/tests/client.scm
index 94c8c5d..1d40c10 100644
--- a/tests/client.scm
+++ b/tests/client.scm
@@ -90,6 +90,8 @@ called with."
(lambda ()
(with-variables (list (cons (var@@ (mumi client) current-issue-number)
(const 12345))
+ (cons (var@@ (mumi client) reply-email-headers)
+ (const '((x-debbugs-cc))))
client-config-stub
do-not-poll-server-for-issue-number)
(cut (@@ (mumi client) send-email)
@@ -116,6 +118,29 @@ called with."
(lambda ()
(with-variables (list (cons (var@@ (mumi client) current-issue-number)
(const 12345))
+ (cons (var@@ (mumi client) reply-email-headers)
+ (const '((x-debbugs-cc))))
+ client-config-stub
+ do-not-poll-server-for-issue-number)
+ (cut (@@ (mumi client) send-email)
+ (list "foo.patch")))))))
+
+(test-equal "send patch to existing issue and Cc other participants"
+ '(("git" "send-email"
+ "--to=12345@example.com"
+ "--add-header=X-Debbugs-Cc: John Doe <jdoe@machine.example>"
+ "--add-header=X-Debbugs-Cc: Mary Smith <mary@example.net>"
+ "foo.patch"))
+ (map (match-lambda
+ ((command _) command))
+ (trace-calls (var@@ (mumi client) call-with-input-pipe)
+ (lambda ()
+ (with-variables (list (cons (var@@ (mumi client) current-issue-number)
+ (const 12345))
+ (cons (var@@ (mumi client) reply-email-headers)
+ (const `((x-debbugs-cc
+ "John Doe <jdoe@machine.example>"
+ "Mary Smith <mary@example.net>"))))
client-config-stub
do-not-poll-server-for-issue-number)
(cut (@@ (mumi client) send-email)
--
2.39.2