[no subject]

[Mathieu Othacehe]

branch: master
commit f6fdb13b506bcb3472f832a6017711b7e2dbfb9d
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sun Feb 21 10:37:11 2021 +0100

    Add Mastodon support.
    
    * src/cuirass/mastodon.scm: New file.
    * Makefile.am (dist_pkgmodule_DATA): Add it.
    * src/cuirass/notification.scm (notification-type): Add "mastodon".
    (notification-mastodon): New procedure.
    (send-notifications): Add it.
---
 Makefile.am                  |  1 +
 src/cuirass/mastodon.scm     | 34 ++++++++++++++++++++++++++++++++++
 src/cuirass/notification.scm | 19 +++++++++++++++++--
 3 files changed, 52 insertions(+), 2 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index dbcc87b..0a22eae 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -54,6 +54,7 @@ dist_pkgmodule_DATA =                         \
   src/cuirass/http.scm                         \
   src/cuirass/logging.scm                      \
   src/cuirass/mail.scm                         \
+  src/cuirass/mastodon.scm                     \
   src/cuirass/metrics.scm                      \
   src/cuirass/notification.scm                 \
   src/cuirass/remote.scm                       \
diff --git a/src/cuirass/mastodon.scm b/src/cuirass/mastodon.scm
new file mode 100644
index 0000000..1cfa6b4
--- /dev/null
+++ b/src/cuirass/mastodon.scm
@@ -0,0 +1,34 @@
+;;; mastodon.scm -- Send new statuses.
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (cuirass mastodon)
+  #:use-module (mastodon)
+  #:use-module (mastodon types)
+  #:export (send-status))
+
+(define* (send-status text
+                      #:key
+                      instance-name
+                      instance-url
+                      instance-token)
+  "Send a new status with the given TEXT to the instance named INSTANCE-NAME
+at the INSTANCE-URL address.  Use the given INSTANCE-TOKEN to authenticate."
+  (let ((instance (make-mastodon instance-name
+                                 instance-url
+                                 instance-token)))
+    (new-status instance #:status text)))
diff --git a/src/cuirass/notification.scm b/src/cuirass/notification.scm
index 0b20ed8..358005e 100644
--- a/src/cuirass/notification.scm
+++ b/src/cuirass/notification.scm
@@ -20,6 +20,7 @@
   #:use-module (cuirass database)
   #:use-module (cuirass logging)
   #:use-module (cuirass mail)
+  #:use-module (cuirass mastodon)
   #:use-module (cuirass utils)
   #:export (notification-type
             notification-event
@@ -54,7 +55,8 @@ interfering with fibers."
      exp ...)))
 
 (define-enumeration notification-type
-  (email            0))
+  (email            0)
+  (mastodon         1))
 
 (define-enumeration notification-event
   (always            0)
@@ -104,6 +106,17 @@ the detailed information about this build here: ~a."
                 #:subject subject
                 #:text text)))
 
+(define (notification-mastodon notification)
+  "Send a new status for the given NOTIFICATION."
+  (let ((name (assq-ref notification #:instance-name))
+        (url (assq-ref notification #:instance-url))
+        (token (assq-ref notification #:instance-token))
+        (text (notification-text notification)))
+    (send-status text
+                 #:instance-name name
+                 #:instance-url url
+                 #:instance-token token)))
+
 (define* (send-notifications notifications #:key build)
   "Send the notifications in NOTIFICATIONS list, regarding the given BUILD."
   (with-notification-worker-thread
@@ -124,5 +137,7 @@ the detailed information about this build here: ~a."
           (let ((notification* (acons #:build build notification)))
             (cond
              ((eq? type (notification-type email))
-              (notification-email notification*)))))))
+              (notification-email notification*))
+             ((eq? type (notification-type mastodon))
+              (notification-mastodon notification*)))))))
     notifications)))