(define-module (arunisaac snac)
  #:use-module ((forge nginx) #:select (forge-nginx-service-type))
  #:use-module (gnu build linux-container)
  #:use-module ((gnu packages admin) #:select (shadow))
  #:use-module ((gnu packages fediverse) #:select (snac2))
  #:use-module ((gnu packages guile) #:select (guile-json-4))
  #:use-module ((gnu packages nss) #:select (nss-certs))
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module ((gnu services web)
                #:select (nginx-server-configuration
                          nginx-location-configuration))
  #:use-module (gnu system file-systems)
  #:use-module (gnu system shadow)
  #:use-module (guix gexp)
  #:use-module (guix least-authority)
  #:use-module (guix records)
  #:export (snac-service-type

            snac-configuration
            snac-configuration-package
            snac-configuration-server-name
            snac-configuration-data-directory))

(define-record-type* <snac-configuration>
  snac-configuration make-snac-configuration
  snac-configuration?
  (package snac-configuration-package
           (default snac2))
  (server-name snac-configuration-server-name)
  (data-directory snac-configuration-data-directory
                  (default "/var/lib/snac")))

(define %snac-unix-socket
  "/var/run/snac/socket")

(define %snac-accounts
  (list (user-account
          (name "snac")
          (group "snac")
          (system? #t)
          (comment "snac user")
          (home-directory "/var/empty")
          (shell (file-append shadow "/sbin/nologin")))
        (user-group
          (name "snac")
          (system? #t))))

(define snac-activation
  (match-record-lambda <snac-configuration>
      (data-directory server-name)
    (with-extensions (list guile-json-4)
      (with-imported-modules '((guix build utils))
        #~(begin
            (use-modules (guix build utils)
                         (json)
                         (srfi srfi-26))

            (let ((user (getpw "snac")))
              ;; Ensure data directory has the right ownership.
              (for-each (lambda (file)
                          (chown file (passwd:uid user) (passwd:gid user)))
                        (find-files #$data-directory
                                    #:directories? #t))
              ;; Create parent directory for the Unix socket.
              (mkdir-p #$(dirname %snac-unix-socket))
              (chown #$(dirname %snac-unix-socket)
                     (passwd:uid user)
                     (passwd:gid user)))
            ;; Mutate server.json setting host and address.
            (let* ((config-file #$(string-append data-directory "/server.json"))
                   (config (call-with-input-file config-file
                             json->scm)))
              (unless (and (assoc "address" config)
                           (assoc "host" config))
                (display "Some of fields \"address\" and \"host\" are missing from server.json; erring on the side of caution by aborting")
                (newline)
                (exit #f))
              (call-with-output-file config-file
                (cut scm->json
                     (append '(("host" . #$server-name)
                               ("address" . #$%snac-unix-socket))
                             (alist-delete "host"
                                           (alist-delete "address" config)))
                     <>
                     #:pretty #t))))))))

(define snac-shepherd-service
  (match-record-lambda <snac-configuration>
      (package data-directory)
    (shepherd-service
      (documentation "Snac ActivityPub instance")
      (provision '(snac))
      (requirement '(networking))
      (start #~(make-forkexec-constructor
                (list #$(least-authority-wrapper
                         (file-append package "/bin/snac")
                         #:name "snac-pola-wrapper"
                         #:mappings (cons* (file-system-mapping
                                             (source data-directory)
                                             (target source)
                                             (writable? #t))
                                           (file-system-mapping
                                             (source (dirname %snac-unix-socket))
                                             (target source)
                                             (writable? #t))
                                           (file-system-mapping
                                             (source (file-append nss-certs "/etc/ssl/certs"))
                                             (target source))
                                           %network-file-mappings)
                         #:preserved-environment-variables (cons "SSL_CERT_DIR"
                                                                 %default-preserved-environment-variables)
                         ;; snac needs to make outgoing network
                         ;; requests.
                         #:namespaces (delq 'net %namespaces))
                      "httpd"
                      #$data-directory)
                #:environment-variables (list (string-append "SSL_CERT_DIR="
                                                             #$(file-append nss-certs "/etc/ssl/certs")))
                #:user "snac"
                #:group "snac"
                #:log-file "/var/log/snac.log"))
      (stop #~(make-kill-destructor)))))

(define snac-nginx-server-blocks
  (match-record-lambda <snac-configuration>
      (server-name)
    (list (nginx-server-configuration
            (server-name (list server-name))
            (locations
             (list (nginx-location-configuration
                     (uri "/")
                     (body
                      (list (string-append "proxy_pass http://unix:"
                                           %snac-unix-socket
                                           ":;")
                            "proxy_set_header Host $host;")))))))))

(define snac-service-type
  (service-type
    (name 'snac)
    (description "Run snac.")
    (extensions (list (service-extension account-service-type
                                         (const %snac-accounts))
                      (service-extension activation-service-type
                                         snac-activation)
                      (service-extension shepherd-root-service-type
                                         (compose list snac-shepherd-service))
                      (service-extension forge-nginx-service-type
                                         snac-nginx-server-blocks)
                      (service-extension profile-service-type
                                         (const (list snac2)))))))