diff options
| -rw-r--r-- | doc/guix.texi | 18 | ||||
| -rw-r--r-- | gnu/services/feed.scm | 136 | ||||
| -rw-r--r-- | gnu/tests/feed.scm | 136 |
3 files changed, 290 insertions, 0 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 0015d739bb..eea1b5342f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -413,6 +413,7 @@ Services * Kerberos Services:: Kerberos services. * LDAP Services:: LDAP services. * Web Services:: Web servers. +* Feed Services:: RSS/Atom feed readers. * Certificate Services:: TLS certificates via Let's Encrypt. * DNS Services:: DNS daemons. * VNC Services:: VNC daemons. @@ -33579,6 +33580,23 @@ The file which should store the logging output of Agate. @end table @end deftp +@node Feed Services +@subsection Feed Services + +@subsubheading Miniflux + +@cindex miniflux +The @uref{https://miniflux.app/, Miniflux} is a minimalist feed reader with the web interface. + +@defvar miniflux-service-type +This is the type of the Miniflux service. + +@end defvar + +@deftp {Data Type} miniflux-configuration +Data type representing the configuration of Miniflux. +@end deftp + @node Certificate Services @subsection Certificate Services diff --git a/gnu/services/feed.scm b/gnu/services/feed.scm new file mode 100644 index 0000000000..9ec61f16ad --- /dev/null +++ b/gnu/services/feed.scm @@ -0,0 +1,136 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Rodion Goritskov <rodion.goritskov@gmail.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; 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 (gnu services feed) + #:use-module (gnu services shepherd) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (gnu packages admin) + #:use-module (gnu packages web) + #:use-module (gnu services databases) + #:use-module (gnu packages web) + #:use-module (ice-9 string-fun) + #:export (miniflux-service-type + miniflux-configuration + miniflux-configuration?)) + +(define (initial-string? val) (string? val)) +(define (initial-boolean? val) (boolean? val)) +(define (strip-initial-prefix field-name) (string-drop (symbol->string field-name) 8)) + +(define (serialize-string field-name val) + (format #f "~a=~a\n" (string-upcase + (string-replace-substring + (if (symbol? field-name) (symbol->string field-name) field-name) "-" "_")) + val)) + +(define (serialize-boolean field-name val) + (if val (serialize-string field-name "1") (serialize-string field-name "0"))) + +;; Initial string is just a string with 'initial-' prefix +(define (serialize-initial-string field-name val) + (serialize-string (strip-initial-prefix field-name) val)) + +(define (serialize-initial-boolean field-name val) + (serialize-boolean (strip-initial-prefix field-name) val)) + +(define-configuration miniflux-configuration + (listen-addr + (string "127.0.0.1:8080") + "Address to listen on. Use absolute path for a Unix socket.") + (base-url + (string "http://localhost/") + "Base URL to generate HTML links and base path for cookies.") + (initial-create-admin + (initial-boolean #f) + "Create an initial admin") + (initial-admin-username + (initial-string "admin") + "Initial admin username") + (initial-admin-password + (initial-string "password") + "Initial admin password") + (run-migrations + (boolean #t) + "Run database migrations during application startup.") + (database-url + (string "host=/var/run/postgresql") + "PostgreSQL connection string") + (user + (string "miniflux") + "User name for Postgresql and system account") + (group + (string "miniflux") + "Group for the system account" + empty-serializer) + (log-file + (string "/var/log/miniflux.log") + "Path to the log file" + empty-serializer)) + +(define miniflux-shepherd-service + (lambda (config) + (let* ((config-file (mixed-text-file "miniflux.conf" (serialize-configuration config miniflux-configuration-fields)))) + (list (shepherd-service + (documentation "Run Miniflux server") + (provision '(miniflux)) + (requirement '(postgres networking)) + (start #~(make-forkexec-constructor + (list (string-append #$miniflux "/bin/miniflux") + "-config-file" #$config-file) + #:user #$(miniflux-configuration-user config) + #:group #$(miniflux-configuration-group config) + #:log-file #$(miniflux-configuration-log-file config))) + (stop #~(make-kill-destructor))))))) + +(define miniflux-accounts + (lambda (config) + (let ((group (miniflux-configuration-group config)) + (user (miniflux-configuration-user config))) + `(,(user-group + (name group) + (system? #t)) + ,(user-account + (name user) + (group group) + (system? #t) + (comment "miniflux server user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))))) + +(define miniflux-postgresql-role + (lambda (config) + (list (postgresql-role + (name (miniflux-configuration-user config)) + (create-database? #t))))) + +(define miniflux-service-type + (service-type + (name 'miniflux) + (default-value (miniflux-configuration)) + (extensions + (list (service-extension account-service-type + miniflux-accounts) + (service-extension postgresql-role-service-type + miniflux-postgresql-role) + (service-extension shepherd-root-service-type + miniflux-shepherd-service))) + (description "Run Miniflux, minimalist feed reader"))) diff --git a/gnu/tests/feed.scm b/gnu/tests/feed.scm new file mode 100644 index 0000000000..8be7d8b826 --- /dev/null +++ b/gnu/tests/feed.scm @@ -0,0 +1,136 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Rodion Goritskov <rodion.goritskov@gmail.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; 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 (gnu tests feed) + #:use-module (gnu tests) + #:use-module (gnu system) + #:use-module (gnu system vm) + #:use-module (gnu services) + #:use-module (gnu services networking) + #:use-module (gnu services databases) + #:use-module (gnu packages databases) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (guix profiles) + #:use-module (gnu services feed) + #:use-module (guix gexp) + #:export (%test-miniflux)) + +(define retry-on-error + #~(lambda* (f #:key times delay) + (let loop ((attempt 1)) + (match (catch + #t + (lambda () + (cons #t + (f))) + (lambda args + (cons #f + args))) + ((#t . return-value) + return-value) + ((#f . error-args) + (if (>= attempt times) + error-args + (begin + (sleep delay) + (loop (+ 1 attempt))))))))) + +(define %miniflux-os + (simple-operating-system + (service dhcp-client-service-type) + (service postgresql-service-type + (postgresql-configuration + (postgresql postgresql-13))) + (service miniflux-service-type + (miniflux-configuration + (listen-addr "0.0.0.0:8080"))))) + +(define* (run-miniflux-test name test-os) + (define os + (marionette-operating-system + test-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define forwarded-port 8080) + + (define vm + (virtual-machine + (operating-system os) + (memory-size 512) + (port-forwardings `((8080 . ,forwarded-port))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-64) + (srfi srfi-11) + (gnu build marionette) + (web client) + (web uri) + (web response) + (ice-9 match)) + + (define marionette + (make-marionette (list #$vm))) + + (test-runner-current (system-test-runner #$output)) + (test-begin #$name) + + (test-assert "Check Miniflux service is running" + (begin + (#$retry-on-error + (lambda () + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service '#$(string->symbol name)) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + (#f #f) + ((running) #t))))) + marionette)) + #:delay 1 + #:times 10))) + + (test-assert "Miniflux TCP port ready, IPv4" + (wait-for-tcp-port #$forwarded-port marionette)) + + (test-assert "Miniflux login page is opened" + (begin + (wait-for-tcp-port #$forwarded-port marionette) + (#$retry-on-error + (lambda () + (let-values (((response text) + (http-get + #$(format #f "http://localhost:~A/" forwarded-port) + #:decode-body? #t))) + (string-contains text "<title>Sign In - Miniflux</title>"))) + #:times 10 + #:delay 5))) + + (test-end)))) + (gexp->derivation "miniflux-test" test)) + +(define %test-miniflux + (system-test + (name "miniflux") + (description "Connect to a running Miniflux service.") + (value (run-miniflux-test name %miniflux-os)))) |