;;; guix-forge --- Guix software forge meta-service
;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of guix-forge.
;;;
;;; guix-forge 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.
;;;
;;; guix-forge 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 guix-forge.  If not, see
;;; <https://www.gnu.org/licenses/>.

(define-module (forge nginx)
  #:use-module (forge acme)
  #:use-module (forge socket)
  #:use-module ((gnu packages admin) #:select (shepherd))
  #:use-module (gnu services)
  #:use-module (gnu services web)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:export (<forge-nginx-configuration>
            forge-nginx-configuration
            forge-nginx-configuration?
            forge-nginx-configuration-http-listen
            forge-nginx-configuration-https-listen
            forge-nginx-configuration-acme-state-directory
            forge-nginx-configuration-acme-challenge-directory
            forge-nginx-configuration-server-blocks
            nginx-socket->string
            forge-nginx-service-type))

(define-record-type* <forge-nginx-configuration>
  forge-nginx-configuration make-forge-nginx-configuration
  forge-nginx-configuration?
  (http-listen forge-nginx-configuration-http-listen
               (default (forge-ip-socket
                         (ip "0.0.0.0")
                         (port 80))))
  (https-listen forge-nginx-configuration-https-listen
                (default (forge-ip-socket
                          (ip "0.0.0.0")
                          (port 443))))
  (acme-state-directory forge-nginx-configuration-acme-state-directory
                        (default "/var/lib/acme"))
  (acme-challenge-directory forge-nginx-configuration-acme-challenge-directory
                            (default "/var/run/acme/acme-challenge"))
  (server-blocks forge-nginx-configuration-server-blocks
                 (default '())))

(define (nginx-socket->string socket)
  "Serialize @var{socket} to a string as expected by nginx
configuration (for example, in the @code{listen} and
@code{fastcgi_pass} directives)."
  (match socket
    (($ <forge-host-socket> hostname port)
     (string-append hostname ":" (number->string port)))
    (($ <forge-ip-socket> (or "0.0.0.0" "::") port)
     (number->string port))
    (($ <forge-ip-socket> (? ipv4-address? ip) port)
     (string-append ip ":" port))
    (($ <forge-ip-socket> (? ipv6-address? ip) port)
     (string-append "[" ip "]" ":" port))
    (($ <forge-unix-socket> path)
     (string-append "unix:" path))))

(define (forge-nginx-server-blocks config)
  "Return list of nginx server blocks to provision for forge-web service
specified by @var{config}."
  (match-record config <forge-nginx-configuration>
    (http-listen https-listen acme-state-directory acme-challenge-directory server-blocks)
    (cons (nginx-server-configuration
           (listen (list (nginx-socket->string http-listen)))
           (locations
            (list (nginx-location-configuration
                   (uri "/.well-known/acme-challenge/")
                   ;; Without a trailing slash, a alias of /var/foo
                   ;; would lookup /bar at /var/foobar, not
                   ;; /var/foo/bar. So, a trailing slash is
                   ;; significant. Append it if not already
                   ;; present. Likewise, the trailing slash in
                   ;; "/.well-known/acme-challenge/" is also
                   ;; significant.
                   (body (list (string-append "alias "
                                              (string-trim-right acme-challenge-directory #\/)
                                              "/;"))))
                  (nginx-location-configuration
                   (uri "/")
                   ;; HTTP Strict Transport Security (HSTS) header as
                   ;; recommended by https://hstspreload.org
                   (body (list "add_header Strict-Transport-Security \"max-age=63072000; includeSubdomains; preload\";"
                               "return 301 https://$host$request_uri;"))))))
          (map (lambda (server)
                 (match (nginx-server-configuration-server-name server)
                   ((name _ ...)
                    (nginx-server-configuration
                     (inherit server)
                     (listen (list (string-append (nginx-socket->string https-listen)
                                                  " ssl")))
                     (ssl-certificate (string-append acme-state-directory
                                                     "/" name "/cert.pem"))
                     (ssl-certificate-key (string-append acme-state-directory
                                                         "/private/" name "/key.pem"))))))
               server-blocks))))

(define %deploy-hook-gexp
  (with-imported-modules '((guix build utils))
    #~(begin
        (use-modules (guix build utils))

        ;; Restart nginx.
        ;; We cannot refer to sudo in the store since that sudo does
        ;; not have the setuid bit set. See "(guix) Setuid Programs".
        (invoke "/run/setuid-programs/sudo"
                #$(file-append shepherd "/bin/herd")
                "restart"
                "nginx"))))

(define (forge-nginx-acme-certificates config)
  "Return list of @code{<acme-certificate>} blocks to provision for
forge-nginx service specified by @var{config}."
  (match-record config <forge-nginx-configuration>
    (server-blocks)
    (map (lambda (server)
           (acme-certificate
            (domains (nginx-server-configuration-server-name server))
            (deploy-hook (program-file "forge-nginx-acme-deploy-hook"
                                       %deploy-hook-gexp))))
         server-blocks)))

(define forge-nginx-service-type
  (service-type
   (name 'forge-nginx)
   (description "Run the forge-nginx web server.")
   (extensions (list (service-extension nginx-service-type
                                        forge-nginx-server-blocks)
                     (service-extension acme-service-type
                                        forge-nginx-acme-certificates)))
   (compose concatenate)
   (extend (lambda (config server-blocks)
             (forge-nginx-configuration
              (inherit config)
              (server-blocks (append (forge-nginx-configuration-server-blocks config)
                                     server-blocks)))))
   (default-value (forge-nginx-configuration))))