client: Support sending email to issues.

* mumi/client.scm: Import (rnrs io ports), (srfi srfi-71), (srfi
srfi-171), (ice-9 match), (ice-9 popen), (web client), (web response)
and (email email).
(issue-number-of-message, call-with-input-pipe, git-send-email): New
functions.
(send-email): New public function.
* scripts/mumi.in (show-mumi-usage): Document send-email subcommand.
(main): Add send-email subcommand.
* tests/client.scm: New file.
* Makefile.am (SCM_TESTS): Add tests/client.scm.

1 files changed, 118 insertions, 0 deletions

diff --git a/tests/client.scm b/tests/client.scm
new file mode 100644
index 0000000..fb03713
--- /dev/null
+++ b/tests/client.scm
@@ -0,0 +1,118 @@
+;;; mumi -- Mediocre, uh, mail interface
+;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero 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
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(use-modules (srfi srfi-26)
+             (srfi srfi-64)
+             (ice-9 match))
+
+(define (with-variable variable value thunk)
+  "Set VARIABLE to VALUE, run THUNK and restore the old value of
+VARIABLE. Return the value returned by THUNK."
+  (let ((old-value (variable-ref variable)))
+    (dynamic-wind
+      (cut variable-set! variable value)
+      thunk
+      (cut variable-set! variable old-value))))
+
+(define (with-variables variable-bindings thunk)
+  "Set VARIABLE-BINDINGS, run THUNK and restore the old values of the
+variables. Return the value returned by THUNK. VARIABLE-BINDINGS is a
+list of pairs mapping variables to their values."
+  (match variable-bindings
+    (((variable . value) tail ...)
+     (with-variable variable value
+       (cut with-variables tail thunk)))
+    (() (thunk))))
+
+(define-syntax-rule (var@@ module-name variable-name)
+  (module-variable (resolve-module 'module-name)
+                   'variable-name))
+
+(define (trace-calls function-variable thunk)
+  "Run THUNK and return a list of argument lists FUNCTION-VARIABLE is
+called with."
+  (let ((args-list (list)))
+    (with-variable function-variable (lambda args
+                                       (set! args-list
+                                             (cons args args-list)))
+      thunk)
+    (reverse args-list)))
+
+(define client-config-stub
+  (cons (var@@ (mumi client) client-config)
+        (lambda (key)
+          (case key
+            ((debbugs-host) "example.com")
+            ((patch-email-address) "foo@patches.com")
+            (else (error "Key unimplemented in stub" key))))))
+
+(test-begin "client")
+
+(test-equal "send patches to new issue"
+  '(("git" "send-email" "--to=foo@patches.com" "foo.patch")
+    ("git" "send-email" "--to=12345@example.com" "bar.patch" "foobar.patch"))
+  (map (match-lambda
+         ((command _) command))
+       (trace-calls (var@@ (mumi client) call-with-input-pipe)
+         (lambda ()
+           (with-variables (list (cons (var@@ (mumi client) issue-number-of-message)
+                                       (const 12345))
+                                 client-config-stub)
+             (cut (@@ (mumi client) send-email)
+                  (list "foo.patch" "bar.patch" "foobar.patch")))))))
+
+(test-equal "send patches to existing issue"
+  '(("git" "send-email" "--to=12345@example.com" "foo.patch" "bar.patch" "foobar.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))
+                                 client-config-stub)
+             (cut (@@ (mumi client) send-email)
+                  (list "foo.patch" "bar.patch" "foobar.patch")))))))
+
+(test-equal "send single patch to new issue"
+  '(("git" "send-email" "--to=foo@patches.com" "foo.patch"))
+  (map (match-lambda
+         ((command _) command))
+       (trace-calls (var@@ (mumi client) call-with-input-pipe)
+         (lambda ()
+           (with-variables (list (cons (var@@ (mumi client) issue-number-of-message)
+                                       (lambda _
+                                         (error "Do not poll server for issue number")))
+                                 client-config-stub)
+             (cut (@@ (mumi client) send-email)
+                  (list "foo.patch")))))))
+
+(test-equal "send single patch to existing issue"
+  '(("git" "send-email" "--to=12345@example.com" "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) issue-number-of-message)
+                                       (lambda _
+                                         (error "Do not poll server for issue number")))
+                                 client-config-stub)
+             (cut (@@ (mumi client) send-email)
+                  (list "foo.patch")))))))
+
+(test-end "client")