;; disfluid, implementation of the Solid specification
;; Copyright (C) 2020, 2021  Vivien Kraus

;; 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 <https://www.gnu.org/licenses/>.

(define-module (vkraus services disfluid)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services admin)
  #:use-module (gnu services web)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages admin)
  #:use-module (vkraus packages disfluid)
  #:use-module (guix gexp)
  #:use-module (guix modules)
  #:use-module (guix records)
  #:use-module (ice-9 match)
  #: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
   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
   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
   disfluid-server-configuration-authorization-endpoint-uri)
  (token-endpoint-uri
   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
    ((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"
                 "--complete-corresponding-source" #$ccs
                 "--server-name" #$issuer
                 "--key-file" #$key-file
                 "--subject" #$subject
                 "--encrypted-password-from-file" #$encrypted-password-file
                 "--jwks-uri" #$jwks-uri
                 "--authorization-endpoint-uri" #$authorization-endpoint-uri
                 "--token-endpoint-uri" #$token-endpoint-uri
                 "--port" (with-output-to-string (lambda () (display #$port)))
                 "--log-file" #$(format #f "issuer-~a.log" id)
                 "--error-file" #$(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)
                  "LANG=C")))))
         (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"
                 "--complete-corresponding-source" #$ccs
                 "--port" (with-output-to-string (lambda () (display #$port)))
                 "--server-name" #$inbound-uri
                 "--backend-uri" #$outbound-uri
                 "--header" #$header
                 "--log-file" #$(format #f "reverse-proxy-~a.log" id)
                 "--error-file" #$(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)
                  "LANG=C")))))
         (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")
                 "--complete-corresponding-source" #$ccs
                 "--port" (with-output-to-string (lambda () (display #$port)))
                 "--log-file" #$(format #f "hello-~a.log" id)
                 "--error-file" #$(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)
                  "LANG=C")))))
         (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"
                 "--complete-corresponding-source" #$ccs
                 "--client-id" #$client-id
                 "--redirect-uri" #$redirect-uri
                 "--client-name" #$client-name
                 "--client-uri" #$client-uri
                 "--port" (with-output-to-string (lambda () (display #$port)))
                 "--log-file" #$(format #f "client-service-~a.log" id)
                 "--error-file" #$(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)
                  "LANG=C")))))
         (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"
                 "--complete-corresponding-source" #$ccs
                 "--server-name" #$server-name
                 "--key-file" #$key-file
                 "--subject" #$subject
                 "--encrypted-password-from-file" #$encrypted-password-file
                 "--jwks-uri" #$jwks-uri
                 "--authorization-endpoint-uri" #$authorization-endpoint-uri
                 "--token-endpoint-uri" #$token-endpoint-uri
                 "--port" (with-output-to-string (lambda () (display #$port)))
                 "--log-file" #$(format #f "server-~a.log" id)
                 "--error-file" #$(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)
                  "LANG=C")))))
         (stop #~(make-kill-destructor)))))
    ((items ...)
     (apply append (map configuration->shepherd-service items)))))

(define %disfluid-accounts
  (list (user-group (name "disfluid")
                    (system? #t))
        (user-account
         (name "disfluid")
         (group "disfluid")
         (system? #t)
         (comment "The user that runs the disfluid servers.")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define configuration->log-rotation
  (match-lambda
    ((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)))))

(define-public disfluid-service-type
  (service-type
   (name 'disfluid)
   (extensions
    (list
     (service-extension account-service-type
                        (const %disfluid-accounts))
     (service-extension rottlog-service-type
                        configuration->log-rotation)
     (service-extension
      shepherd-root-service-type
      configuration->shepherd-service)))))

(define-public disfluid-website
  (nginx-server-configuration
   (server-name '("disfluid.planete-kraus.eu" "webid-oidc.planete-kraus.eu"))
   (listen '("443 ssl" "[::]:443 ssl"))
   (ssl-certificate "/etc/letsencrypt/live/planete-kraus.eu/fullchain.pem")
   (ssl-certificate-key "/etc/letsencrypt/live/planete-kraus.eu/privkey.pem")
   (root disfluid:website)
   (locations
    (list
     (nginx-location-configuration
      (uri "/project")
      (body
       (list "default_type text/turtle ;")))))))