Update package

1 files changed, 412 insertions, 354 deletions

diff --git a/vkraus/services/disfluid.scm b/vkraus/services/disfluid.scm
index ecd0f33..21adca2 100644
--- a/vkraus/services/disfluid.scm
+++ b/vkraus/services/disfluid.scm
@@ -23,354 +23,387 @@
   #:use-module (gnu packages admin)
   #:use-module (vkraus packages disfluid)
   #:use-module (guix gexp)
-  #:use-module (guix packages)
   #:use-module (guix modules)
+  #:use-module (guix records)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 optargs)
-  #:use-module (ice-9 receive)
-  #:use-module (web uri)
-  #:use-module (oop goops)
-  #:declarative? #t
-  #:export
-  (
-   <disfluid-configuration>
-   disfluid-package
-   extra-options
-   <disfluid-server-configuration>
-   complete-corresponding-source
-   port
-   <disfluid-issuer-configuration>
-   issuer
-   key-file
-   subject
-   encrypted-password-file
-   jwks-uri
-   authorization-endpoint-uri
-   token-endpoint-uri
-   <disfluid-reverse-proxy-configuration>
-   inbound-uri
-   outbound-uri
-   header
-   <disfluid-hello-configuration>
-   <disfluid-client-service-configuration>
-   client-id
-   redirect-uri
-   client-name
-   client-uri
-   <disfluid-full-server-configuration>
-   server-name
-
-   kind
-   document
-   invocation
-   ->shepherd-service
-   ->log-rotation
-
-   disfluid-service-type
-   disfluid-website
-   ))
-
-(define-class <disfluid-configuration> ()
-  (disfluid-package
-   #:init-keyword #:disfluid-package
-   #:init-value disfluid
-   #:getter disfluid-package)
+  #:use-module (ice-9 optargs))
+
+(define-record-type* <disfluid-issuer-configuration>
+  disfluid-issuer-configuration
+  make-disfluid-issuer-configuration
+  disfluid-issuer-configuration?
+  (disfluid disfluid-issuer-configuration-disfluid
+              (default disfluid))
+  (complete-corresponding-source
+   disfluid-issuer-configuration-complete-corresponding-source)
+  (issuer disfluid-issuer-configuration-issuer)
+  (key-file disfluid-issuer-configuration-key-file)
+  (subject disfluid-issuer-configuration-subject)
+  (encrypted-password-file disfluid-issuer-configuration-encrypted-password-file)
+  (jwks-uri disfluid-issuer-configuration-jwks-uri)
+  (authorization-endpoint-uri
+   disfluid-issuer-configuration-authorization-endpoint-uri)
+  (token-endpoint-uri
+   disfluid-issuer-configuration-token-endpoint-uri)
+  (port disfluid-issuer-configuration-port (default 8088))
   (extra-options
-   #:init-keyword #:extra-options
-   #:init-value '()
-   #:getter extra-options))
-
-(define-class <disfluid-server-configuration> (<disfluid-configuration>)
+   disfluid-issuer-configuration-extra-options
+   (default '())))
+
+(define-record-type* <disfluid-reverse-proxy-configuration>
+  disfluid-reverse-proxy-configuration
+  make-disfluid-reverse-proxy-configuration
+  disfluid-reverse-proxy-configuration?
+  (disfluid disfluid-reverse-proxy-configuration-disfluid
+              (default disfluid))
   (complete-corresponding-source
-   #:init-keyword #:complete-corresponding-source
-   #:getter complete-corresponding-source)
-  (port
-   #:init-keyword #:port
-   #:getter port))
-
-(define-class <disfluid-issuer-configuration> (<disfluid-server-configuration>)
-  (issuer #:init-keyword #:issuer #:getter issuer)
-  (key-file #:init-keyword #:key-file #:getter key-file)
-  (subject #:init-keyword #:subject #:getter subject)
-  (encrypted-password-file
-   #:init-keyword #:encrypted-password-file
-   #:accessor encrypted-password-file)
-  (jwks-uri #:init-keyword #:jwks-uri #:getter jwks-uri)
+   disfluid-reverse-proxy-configuration-complete-corresponding-source)
+  (port disfluid-reverse-proxy-port (default 8090))
+  (inbound-uri disfluid-reverse-proxy-configuration-inbound-uri)
+  (outbound-uri disfluid-reverse-proxy-configuration-outbound-uri)
+  (header disfluid-reverse-proxy-configuration-header
+          (default "XXX-Agent"))
+  (extra-options
+   disfluid-reverse-proxy-extra-options
+   (default '())))
+
+(define-record-type* <disfluid-hello-configuration>
+  disfluid-hello-configuration
+  make-disfluid-hello-configuration
+  disfluid-hello-configuration?
+  (disfluid disfluid-hello-configuration-disfluid
+              (default disfluid))
+  (complete-corresponding-source
+   disfluid-hello-configuration-complete-corresponding-source)
+  (port disfluid-hello-configuration-port (default 8089))
+  (extra-options
+   disfluid-hello-configuration-extra-options
+   (default '())))
+
+(define-record-type* <disfluid-client-service-configuration>
+  disfluid-client-service-configuration
+  make-disfluid-client-service-configuration
+  disfluid-client-service-configuration?
+  (disfluid disfluid-client-service-configuration-disfluid
+              (default disfluid))
+  (complete-corresponding-source
+   disfluid-client-service-configuration-complete-corresponding-source)
+  (client-id disfluid-client-service-configuration-client-id)
+  (redirect-uri disfluid-client-service-configuration-redirect-uri)
+  (client-name disfluid-client-service-configuration-client-name (default "Example Solid App"))
+  (client-uri disfluid-client-service-configuration-client-uri (default "https://webid-oidc.planete-kraus.eu/Running-a-client.html#Running-a-client"))
+  (port disfluid-client-service-configuration-port (default 8088))
+  (extra-options
+   disfluid-client-service-configuration-extra-options
+   (default '())))
+
+(define-record-type* <disfluid-server-configuration>
+  disfluid-server-configuration
+  make-disfluid-server-configuration
+  disfluid-server-configuration?
+  (disfluid disfluid-server-configuration-disfluid
+              (default disfluid))
+  (complete-corresponding-source
+   disfluid-server-configuration-complete-corresponding-source)
+  (server-name disfluid-server-configuration-server-name)
+  (key-file disfluid-server-configuration-key-file)
+  (subject disfluid-server-configuration-subject)
+  (encrypted-password-file disfluid-server-configuration-encrypted-password-file)
+  (jwks-uri disfluid-server-configuration-jwks-uri)
   (authorization-endpoint-uri
-   #:init-keyword #:authorization-endpoint-uri
-   #:getter authorization-endpoint-uri)
+   disfluid-server-configuration-authorization-endpoint-uri)
   (token-endpoint-uri
-   #:init-keyword #:token-endpoint-uri
-   #:getter token-endpoint-uri))
-
-(define-class <disfluid-reverse-proxy-configuration> (<disfluid-server-configuration>)
-  (inbound-uri #:init-keyword #:inbound-uri #:getter inbound-uri)
-  (outbound-uri #:init-keyword #:outbound-uri #:getter outbound-uri)
-  (header #:init-keyword #:header #:getter header #:init-value "XXX-Agent"))
-
-(define-class <disfluid-hello-configuration> (<disfluid-server-configuration>))
-
-(define-class <disfluid-client-service-configuration> (<disfluid-server-configuration>)
-  (client-id #:init-keyword #:client-id #:getter client-id)
-  (redirect-uri #:init-keyword #:redirect-uri #:getter redirect-uri)
-  (client-name
-   #:init-keyword #:client-name
-   #:getter client-name
-   #:init-value "Example Solid App")
-  (client-uri
-   #:init-keyword #:client-uri
-   #:getter client-uri
-   #:init-value (string->uri
-                 "https://disfluid.planete-kraus.eu/Running-a-client.html#Running-a-client")))
-
-(define-class <disfluid-full-server-configuration> (<disfluid-issuer-configuration>)
-  (server-name #:init-keyword #:server-name #:getter server-name))
-
-(define-method (initialize (cfg <disfluid-configuration>) initargs)
-  (next-method)
-  (unless (package? (disfluid-package cfg))
-    (scm-error 'wrong-type-arg "make <disfluid-configuration>"
-               "#:disfluid-package argument should be a package"
-               '()
-               (list (disfluid-package cfg))))
-  (unless (list? (extra-options cfg))
-    (scm-error 'wrong-type-arg "make <disfluid-configuration>"
-               "#:extra-options argument should be a list"
-               '()
-               (list (extra-options cfg)))))
-
-(define-method (initialize (cfg <disfluid-server-configuration>) initargs)
-  (next-method)
-  (let ((ccs (complete-corresponding-source cfg))
-        (port (port cfg)))
-    (unless (or (string? ccs) (uri? ccs))
-      (scm-error 'wrong-type-arg "make <disfluid-server-configuration>"
-                 "#:complete-corresponding-source should be a string or an URI"
-                 '()
-                 (list ccs)))
-    (unless (and (integer? port)
-                 (> port 0)
-                 (< port 65536))
-      (scm-error 'wrong-type-arg "make <disfluid-server-configuration>"
-                 "#:port should be a port number"
-                 '()
-                 (list port)))))
-
-(define string->uri*
-  ;; Try to convert a string to an URI, but keep the old value if it
-  ;; fails
-  (match-lambda
-    ((or (? uri? uri)
-         (? string? (= string->uri (? uri? uri))))
-     uri)
-    (non-uri non-uri)))
-
-(define (uri-slot! object slot-name)
-  (slot-set! object slot-name
-             (string->uri* (slot-ref object slot-name)))
-  (unless (uri? (slot-ref object slot-name))
-    (scm-error 'wrong-type-arg "make"
-               (format #f "#:~a should be an URI" slot-name)
-               '()
-               (list (slot-ref object slot-name)))))
-
-(define (string/file-like-slot! object slot-name)
-  (let ((value (slot-ref object slot-name)))
-    (unless (or (string? value) (file-like? value))
-      (scm-error 'wrong-type-arg "make"
-                 (format #f "#:~a should be a file name or a file-like object"
-                         slot-name)
-                 '()
-                 (list value)))))
-
-(define-method (initialize (cfg <disfluid-issuer-configuration>) initargs)
-  (next-method)
-  (uri-slot! cfg 'issuer)
-  (string/file-like-slot! cfg 'key-file)
-  (uri-slot! cfg 'subject)
-  (string/file-like-slot! cfg 'encrypted-password-file)
-  (uri-slot! cfg 'jwks-uri)
-  (uri-slot! cfg 'authorization-endpoint-uri)
-  (uri-slot! cfg 'token-endpoint-uri))
-
-(define-method (initialize (cfg <disfluid-reverse-proxy-configuration>) initargs)
-  (next-method)
-  (uri-slot! cfg 'inbound-uri)
-  (uri-slot! cfg 'outbound-uri)
-  (when (symbol? (header cfg))
-    (slot-set! cfg 'header (symbol->string (header cfg))))
-  (unless (string? (header cfg))
-    (scm-error 'wrong-type-arg "make"
-               "#:header should be a symbol or a string")
-               '()
-               (list (header cfg))))
-
-(define-method (initialize (cfg <disfluid-client-service-configuration>) initargs)
-  (next-method)
-  (uri-slot! cfg 'client-id)
-  (uri-slot! cfg 'redirect-uri)
-  (unless (string? (client-name cfg))
-    (scm-error 'wrong-type-arg "make"
-               "#:client-name should be a string")
-               '()
-               (list (client-name cfg)))
-  (uri-slot! cfg 'client-uri))
-
-(define-method (initialize (cfg <disfluid-full-server-configuration>) initargs)
-  (let-keywords
-   initargs #t
-   ((server-name #f))
-   (begin
-     (slot-set! cfg 'server-name server-name)
-     (uri-slot! cfg 'server-name)
-     (slot-set! cfg 'issuer server-name)
-     (uri-slot! cfg 'issuer)))
-  ;; #:issuer defaults to the server name
-  (next-method)
-  ;; server-name has been reset
-  (uri-slot! cfg 'server-name))
-
-(define-method (kind (cfg <disfluid-issuer-configuration>))
-  "issuer")
-
-(define-method (kind (cfg <disfluid-reverse-proxy-configuration>))
-  "reverse-proxy")
-
-(define-method (kind (cfg <disfluid-hello-configuration>))
-  "hello")
-
-(define-method (kind (cfg <disfluid-client-service-configuration>))
-  "client-service")
-
-(define-method (kind (cfg <disfluid-full-server-configuration>))
-  "server")
-
-(define-method (document (cfg <disfluid-issuer-configuration>) (id <string>))
-  (format #f "Run a Solid identity provider for ~a (~a)"
-          (uri->string (issuer cfg)) id))
-
-(define-method (document (cfg <disfluid-reverse-proxy-configuration>) (id <string>))
-  (format #f "Run a Solid reverse proxy from ~a to ~a (~a)"
-          (uri->string (inbound-uri cfg)) (outbound-uri cfg) id))
-
-(define-method (document (cfg <disfluid-hello-configuration>) (id <string>))
-  (format #f "Run a demonstration Solid server on port ~a (~a)"
-          (port cfg) id))
-
-(define-method (document (cfg <disfluid-client-service-configuration>) (id <string>))
-  (format #f "Serve the public pages for ~a (~a)"
-          (uri->string (client-id cfg)) id))
-
-(define-method (document (cfg <disfluid-full-server-configuration>) (id <string>))
-  (format #f "Run the Solid server ~a (~a)"
-          (uri->string (server-name cfg)) id))
-
-(define-method (invocation (cfg <disfluid-configuration>) (id <string>))
-  ;; Return the program name, command and arguments
-  (values "/bin/disfluid"
-          #f
-          `("-l" ,(string-append (kind cfg) "-" id ".log")
-            "-e" ,(string-append (kind cfg) "-" id ".err")
-            ,@(extra-options cfg))))
-
-(define-method (invocation (cfg <disfluid-server-configuration>) (id <string>))
-  (receive (program-name command arguments) (next-method)
-    (values program-name
-            command
-            `("-S" ,(let ((ccs (complete-corresponding-source cfg)))
-                      (if (uri? ccs) (uri->string ccs) ccs))
-              "-p" ,(with-output-to-string
-                      (lambda () (display (port cfg))))
-              ,@arguments))))
-
-(define-method (invocation (cfg <disfluid-issuer-configuration>) (id <string>))
-  (receive (_program _command arguments) (next-method)
-    (values "/bin/disfluid"
-            "identity-provider"
-            `("-n" (uri->string (issuer cfg))
-              "-k" (key-file cfg)
-              "-s" (uri->string (subject cfg))
-              "-W" (encrypted-password-file cfg)
-              "-j" (uri->string (jwks-uri cfg))
-              "-a" (uri->string (authorization-endpoint-uri cfg))
-              "-t" (uri->string (token-endpoint-uri cfg))
-              ,@arguments))))
-
-(define-method (invocation (cfg <disfluid-reverse-proxy-configuration>) (id <string>))
-  (receive (_program _command arguments) (next-method)
-    (values "/bin/disfluid"
-            "reverse-proxy"
-            `("-n" (uri->string (inbound-uri cfg))
-              "-b" (uri->string (outbound-uri cfg))
-              "-H" (header cfg)
-              ,@arguments))))
-
-(define-method (invocation (cfg <disfluid-hello-configuration>) (id <string>))
-  (receive (_program _command arguments) (next-method)
-    (values "/bin/disfluid-hello"
-            #f
-            arguments)))
-
-(define-method (invocation (cfg <disfluid-client-service-configuration>) (id <string>))
-  (receive (_program _command arguments) (next-method)
-    (values "/bin/disfluid"
-            "client-service"
-            `("-c" (uri->string (client-id cfg))
-              "-r" (uri->string (redirect-uri cfg))
-              "-C" (client-name cfg)
-              "-u" (uri->string (client-uri cfg))
-              ,@arguments))))
-
-(define-method (invocation (cfg <disfluid-full-server-configuration>) (id <string>))
-  (receive (_program _command arguments) (next-method)
-    (values "/bin/disfluid"
-            "server"
-            `("-n" (uri->string (server-name cfg))
-              ,@arguments))))
-
-(define (->shepherd-service cfg id)
-  (receive (program-name command arguments) (invocation cfg id)
-    (define all-arguments `(command ,@arguments))
-    (shepherd-service
-     (provision (list (string->symbol (format #f "disfluid-~a" id))))
-     (documentation (document cfg id))
-     (requirement '(user-processes))
-     (modules '((gnu build shepherd)
-                (gnu system file-systems)))
-     (start
-      (with-imported-modules
-          '((gnu build shepherd)
-            (gnu system file-systems))
-        #~(begin
-            (let* ((user (getpwnam "disfluid"))
-                   (prepare-directory
-                    (lambda (dir)
-                      (mkdir-p dir)
-                      (chown dir (passwd:uid user) (passwd:gid user))
-                      (chmod dir #o700))))
-              (prepare-directory "/var/log/disfluid")
-              (prepare-directory #$(format #f "/var/lib/disfluid/~a" id))
-              (prepare-directory #$(format #f "/var/cache/disfluid/~a" id)))
-            (make-forkexec-constructor
-             (cons (string-append #$(disfluid-package cfg) #$program-name)
-                   #$all-arguments)
-             #:user "disfluid"
-             #:group "disfluid"
-             #:directory "/var/log/disfluid"
-             #:environment-variables
-             '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id)
-                 #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id))))))
-     (stop #~(make-kill-destructor)))))
+   disfluid-server-configuration-token-endpoint-uri)
+  (port disfluid-server-configuration-port (default 8088))
+  (extra-options
+   disfluid-issuer-configuration-extra-options
+   (default '())))
+
+(export <disfluid-issuer-configuration>
+        disfluid-issuer-configuration
+        make-disfluid-issuer-configuration
+        disfluid-issuer-configuration?
+        disfluid-issuer-configuration-disfluid
+        disfluid-issuer-configuration-complete-corresponding-source
+        disfluid-issuer-configuration-issuer
+        disfluid-issuer-configuration-key-file
+        disfluid-issuer-configuration-subject
+        disfluid-issuer-configuration-encrypted-password-file
+        disfluid-issuer-configuration-jwks-uri
+        disfluid-issuer-configuration-authorization-endpoint-uri
+        disfluid-issuer-configuration-token-endpoint-uri
+        disfluid-issuer-configuration-port
+        disfluid-issuer-configuration-extra-options
+        <disfluid-reverse-proxy-configuration>
+        disfluid-reverse-proxy-configuration
+        make-disfluid-reverse-proxy-configuration
+        disfluid-reverse-proxy-configuration?
+        disfluid-reverse-proxy-configuration-disfluid
+        disfluid-reverse-proxy-configuration-complete-corresponding-source
+        disfluid-reverse-proxy-configuration-port
+        disfluid-reverse-proxy-configuration-inbound-uri
+        disfluid-reverse-proxy-configuration-outbound-uri
+        disfluid-reverse-proxy-configuration-header
+        disfluid-reverse-proxy-configuration-extra-options
+        <disfluid-hello-configuration>
+        disfluid-hello-configuration
+        make-disfluid-hello-configuration
+        disfluid-hello-configuration?
+        disfluid-hello-configuration-disfluid
+        disfluid-hello-configuration-complete-corresponding-source
+        disfluid-hello-configuration-port
+        disfluid-hello-configuration-extra-options
+        <disfluid-client-service-configuration>
+        disfluid-client-service-configuration
+        make-disfluid-client-service-configuration
+        disfluid-client-service-configuration?
+        disfluid-client-service-configuration-disfluid
+        disfluid-client-service-configuration-complete-corresponding-source
+        disfluid-client-service-configuration-client-id
+        disfluid-client-service-configuration-redirect-uri
+        disfluid-client-service-configuration-client-name
+        disfluid-client-service-configuration-client-uri
+        disfluid-client-service-configuration-port
+        disfluid-client-service-configuration-extra-options
+        <disfluid-server-configuration>
+        disfluid-server-configuration
+        make-disfluid-server-configuration
+        disfluid-server-configuration?
+        disfluid-server-configuration-disfluid
+        disfluid-server-configuration-complete-corresponding-source
+        disfluid-server-configuration-server-name
+        disfluid-server-configuration-key-file
+        disfluid-server-configuration-subject
+        disfluid-server-configuration-encrypted-password-file
+        disfluid-server-configuration-jwks-uri
+        disfluid-server-configuration-authorization-endpoint-uri
+        disfluid-server-configuration-token-endpoint-uri
+        disfluid-server-configuration-port
+        disfluid-server-configuration-extra-options)
 
 (define configuration->shepherd-service
   (match-lambda
-    (((or (? symbol? (= symbol->string id))
-          (? string? id)) . cfg)
-     (list (->shepherd-service cfg id)))
+    ((id . ($ <disfluid-issuer-configuration>
+              disfluid ccs issuer key-file subject encrypted-password-file jwks-uri
+              authorization-endpoint-uri token-endpoint-uri port extra-options))
+     `(,(shepherd-service
+         (provision (list (string->symbol (format #f "disfluid-~a" id))))
+         (documentation (format #f "Run a Solid identity provider (~a)" id))
+         (requirement '(user-processes))
+         (modules '((gnu build shepherd)
+                    (gnu system file-systems)))
+         (start
+          (with-imported-modules
+           (source-module-closure
+            '((gnu build shepherd)
+              (gnu system file-systems)))
+           #~(begin
+               (let* ((user (getpwnam "disfluid"))
+                      (prepare-directory
+                       (lambda (dir)
+                         (mkdir-p dir)
+                         (chown dir (passwd:uid user) (passwd:gid user))
+                         (chmod dir #o700))))
+                 (prepare-directory "/var/log/disfluid")
+                 (prepare-directory #$(format #f "/var/lib/disfluid/~a" id))
+                 (prepare-directory #$(format #f "/var/cache/disfluid/~a" id)))
+               (make-forkexec-constructor
+                (list
+                 (string-append #$disfluid "/bin/disfluid")
+                 "identity-provider"
+                 "-S" #$ccs
+                 "-n" #$issuer
+                 "-k" #$key-file
+                 "-s" #$subject
+                 "-W" #$encrypted-password-file
+                 "-j" #$jwks-uri
+                 "-a" #$authorization-endpoint-uri
+                 "-t" #$token-endpoint-uri
+                 "-p" (with-output-to-string (lambda () (display #$port)))
+                 "-l" #$(format #f "issuer-~a.log" id)
+                 "-e" #$(format #f "issuer-~a.err" id)
+                 #$@extra-options)
+                #:user "disfluid"
+                #:group "disfluid"
+                #:directory "/var/log/disfluid"
+                #:environment-variables
+                '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id)
+                  #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id))))))
+         (stop #~(make-kill-destructor)))))
+    ((id . ($ <disfluid-reverse-proxy-configuration>
+              disfluid ccs port inbound-uri outbound-uri header extra-options))
+     `(,(shepherd-service
+         (provision (list (string->symbol (format #f "disfluid-~a" id))))
+         (documentation (format #f "Run a Solid reverse proxy (~a)" id))
+         (requirement '(user-processes))
+         (modules '((gnu build shepherd)
+                    (gnu system file-systems)))
+         (start
+          (with-imported-modules
+           (source-module-closure
+            '((gnu build shepherd)
+              (gnu system file-systems)))
+           #~(begin
+               (let* ((user (getpwnam "disfluid"))
+                      (prepare-directory
+                       (lambda (dir)
+                         (mkdir-p dir)
+                         (chown dir (passwd:uid user) (passwd:gid user))
+                         (chmod dir #o700))))
+                 (prepare-directory "/var/log/disfluid")
+                 (prepare-directory #$(format #f "/var/lib/disfluid/~a" id))
+                 (prepare-directory #$(format #f "/var/cache/disfluid/~a" id)))
+               (make-forkexec-constructor
+                (list
+                 (string-append #$disfluid "/bin/disfluid")
+                 "reverse-proxy"
+                 "-S" #$ccs
+                 "-p" (with-output-to-string (lambda () (display #$port)))
+                 "-n" #$inbound-uri
+                 "-b" #$outbound-uri
+                 "-H" #$header
+                 "-l" #$(format #f "reverse-proxy-~a.log" id)
+                 "-e" #$(format #f "reverse-proxy-~a.err" id)
+                 #$@extra-options)
+                #:user "disfluid"
+                #:group "disfluid"
+                #:directory "/var/log/disfluid"
+                #:environment-variables
+                '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id)
+                  #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id))))))
+         (stop #~(make-kill-destructor)))))
+    ((id . ($ <disfluid-hello-configuration>
+              disfluid ccs port extra-options))
+     `(,(shepherd-service
+         (provision (list (string->symbol (format #f "disfluid-~a" id))))
+         (documentation (format #f "Run a demonstration Solid server (~a)" id))
+         (requirement '(user-processes))
+         (modules '((gnu build shepherd)
+                    (gnu system file-systems)))
+         (start
+          (with-imported-modules
+           (source-module-closure
+            '((gnu build shepherd)
+              (gnu system file-systems)))
+           #~(begin
+               (let* ((user (getpwnam "disfluid"))
+                      (prepare-directory
+                       (lambda (dir)
+                         (mkdir-p dir)
+                         (chown dir (passwd:uid user) (passwd:gid user))
+                         (chmod dir #o700))))
+                 (prepare-directory "/var/log/disfluid")
+                 (prepare-directory #$(format #f "/var/lib/disfluid/~a" id))
+                 (prepare-directory #$(format #f "/var/cache/disfluid/~a" id)))
+               (make-forkexec-constructor
+                (list
+                 (string-append #$disfluid "/bin/disfluid-hello")
+                 "-S" #$ccs
+                 "-p" (with-output-to-string (lambda () (display #$port)))
+                 "-l" #$(format #f "hello-~a.log" id)
+                 "-e" #$(format #f "hello-~a.err" id)
+                 #$@extra-options)
+                #:user "disfluid"
+                #:group "disfluid"
+                #:directory "/var/log/disfluid"
+                #:environment-variables
+                '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id)
+                  #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id))))))
+         (stop #~(make-kill-destructor)))))
+    ((id . ($ <disfluid-client-service-configuration>
+              disfluid ccs client-id redirect-uri client-name client-uri port
+              extra-options))
+     `(,(shepherd-service
+         (provision (list (string->symbol (format #f "disfluid-~a" id))))
+         (documentation (format #f "Serve the public page for an application (~a)" id))
+         (requirement '(user-processes))
+         (modules '((gnu build shepherd)
+                    (gnu system file-systems)))
+         (start
+          (with-imported-modules
+           (source-module-closure
+            '((gnu build shepherd)
+              (gnu system file-systems)))
+           #~(begin
+               (let* ((user (getpwnam "disfluid"))
+                      (prepare-directory
+                       (lambda (dir)
+                         (mkdir-p dir)
+                         (chown dir (passwd:uid user) (passwd:gid user))
+                         (chmod dir #o700))))
+                 (prepare-directory "/var/log/disfluid")
+                 (prepare-directory #$(format #f "/var/lib/disfluid/~a" id))
+                 (prepare-directory #$(format #f "/var/cache/disfluid/~a" id)))
+               (make-forkexec-constructor
+                (list
+                 (string-append #$disfluid "/bin/disfluid")
+                 "client-service"
+                 "-S" #$ccs
+                 "-c" #$client-id
+                 "-r" #$redirect-uri
+                 "-C" #$client-name
+                 "-u" #$client-uri
+                 "-p" (with-output-to-string (lambda () (display #$port)))
+                 "-l" #$(format #f "client-service-~a.log" id)
+                 "-e" #$(format #f "client-service-~a.err" id)
+                 #$@extra-options)
+                #:user "disfluid"
+                #:group "disfluid"
+                #:directory "/var/log/disfluid"
+                #:environment-variables
+                '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id)
+                  #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id))))))
+         (stop #~(make-kill-destructor)))))
+    ((id . ($ <disfluid-server-configuration>
+              disfluid ccs server-name key-file subject encrypted-password-file jwks-uri
+              authorization-endpoint-uri token-endpoint-uri port
+              extra-options))
+     `(,(shepherd-service
+         (provision (list (string->symbol (format #f "disfluid-~a" id))))
+         (documentation (format #f "Run a full server (~a)" id))
+         (requirement '(user-processes))
+         (modules '((gnu build shepherd)
+                    (gnu system file-systems)))
+         (start
+          (with-imported-modules
+           (source-module-closure
+            '((gnu build shepherd)
+              (gnu system file-systems)))
+           #~(begin
+               (let* ((user (getpwnam "disfluid"))
+                      (prepare-directory
+                       (lambda (dir)
+                         (mkdir-p dir)
+                         (chown dir (passwd:uid user) (passwd:gid user))
+                         (chmod dir #o700))))
+                 (prepare-directory "/var/log/disfluid")
+                 (prepare-directory #$(format #f "/var/lib/disfluid/~a" id))
+                 (prepare-directory #$(format #f "/var/cache/disfluid/~a" id)))
+               (make-forkexec-constructor
+                (list
+                 (string-append #$disfluid "/bin/disfluid")
+                 "server"
+                 "-S" #$ccs
+                 "-n" #$server-name
+                 "-k" #$key-file
+                 "-s" #$subject
+                 "-W" #$encrypted-password-file
+                 "-j" #$jwks-uri
+                 "-a" #$authorization-endpoint-uri
+                 "-t" #$token-endpoint-uri
+                 "-p" (with-output-to-string (lambda () (display #$port)))
+                 "-l" #$(format #f "server-~a.log" id)
+                 "-e" #$(format #f "server-~a.err" id)
+                 #$@extra-options)
+                #:user "disfluid"
+                #:group "disfluid"
+                #:directory "/var/log/disfluid"
+                #:environment-variables
+                '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id)
+                  #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id))))))
+         (stop #~(make-kill-destructor)))))
     ((items ...)
-     (apply append (map configuration->shepherd-service items)))
-    (only-one-cfg
-     (configuration->shepherd-service `(default . ,only-one-cfg)))))
+     (apply append (map configuration->shepherd-service items)))))
 
 (define %disfluid-accounts
   (list (user-group (name "disfluid")
@@ -383,25 +416,50 @@
          (home-directory "/var/empty")
          (shell (file-append shadow "/sbin/nologin")))))
 
-(define-method (->log-rotation (cfg <disfluid-server-configuration>)
-                               (id <string>))
-  (log-rotation
-   (frequency 'daily)
-   (files
-    (map (lambda (ext)
-           (format #f "/var/log/disfluid/~a-~a.~a" (kind cfg) id ext))
-         '("log err")))
-   (options '("sharedscripts" "storedir /var/log/disfluid"))))
-
 (define configuration->log-rotation
   (match-lambda
-    (((or (? symbol? (= symbol->string id))
-          (? string? id)) . cfg)
-     (list (->log-rotation cfg id)))
+    ((id . ($ <disfluid-issuer-configuration>))
+     `(,(log-rotation
+         (frequency 'daily)
+         (files
+          (map (lambda (ext)
+                 (format #f "/var/log/disfluid/issuer-~a.~a" id ext))
+               '("log err")))
+         (options '("sharedscripts" "storedir /var/log/disfluid")))))
+    ((id . ($ <disfluid-reverse-proxy-configuration>))
+     `(,(log-rotation
+         (frequency 'daily)
+         (files
+          (map (lambda (ext)
+                 (format #f "/var/log/disfluid/reverse-proxy-~a.~a" id ext))
+               '("log err")))
+         (options '("sharedscripts" "storedir /var/log/disfluid")))))
+    ((id . ($ <disfluid-hello-configuration>))
+     `(,(log-rotation
+         (frequency 'daily)
+         (files
+          (map (lambda (ext)
+                 (format #f "/var/log/disfluid/hello-~a.~a" id ext))
+               '("log err")))
+         (options '("sharedscripts" "storedir /var/log/disfluid")))))
+    ((id . ($ <disfluid-client-service-configuration>))
+     `(,(log-rotation
+         (frequency 'daily)
+         (files
+          (map (lambda (ext)
+                 (format #f "/var/log/disfluid/client-service-~a.~a" id ext))
+               '("log err")))
+         (options '("sharedscripts" "storedir /var/log/disfluid")))))
+    ((id . ($ <disfluid-server-configuration>))
+     `(,(log-rotation
+         (frequency 'daily)
+         (files
+          (map (lambda (ext)
+                 (format #f "/var/log/disfluid/server-~a.~a" id ext))
+               '("log err")))
+         (options '("sharedscripts" "storedir /var/log/disfluid")))))
     ((items ...)
-     (apply append (map configuration->log-rotation items)))
-    (only-one-cfg
-     (configuration->log-rotation `(default . ,only-one-cfg)))))
+     (apply append (map configuration->log-rotation items)))))
 
 (define-public disfluid-service-type
   (service-type