;;; Tyreunom's system administration and configuration tools.

;;;

;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This program 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.

;;;

;;; 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 General Public License for more details.

;;;

;;; You should have received a copy of the GNU General Public License

;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;

;; Cuirass service type and related configurations (web, ...)

;;

(define-module (config cuirass)

  #:use-module (guix gexp)

  #:use-module (gnu services)

  #:use-module (gnu services base)

  #:use-module (gnu services cuirass)

  #:use-module (gnu services web)

  #:export (cuirass-services

            %cuirass-extra-content))

(define %publish-port 3000)

(define %publish-url

  (string-append "http://localhost:" (number->string %publish-port)))

(define* (guix-input name #:optional (branch "master"))

  `((#:name . ,name)

    (#:url . "https://git.savannah.gnu.org/git/guix.git")

    (#:load-path . ".")

    (#:branch . ,branch)

    (#:no-compile? . #t)))

(define %cuirass-specifications

  #~(list

      '((#:name . "guix-modular-master")

        (#:load-path-inputs . ())

        (#:package-path-inputs . ())

        (#:proc-input . "guix-modular")

        (#:proc-file . "build-aux/cuirass/guix-modular.scm")

        (#:proc . cuirass-jobs)

        (#:proc-args (systems . ("x86_64-linux")))

        (#:inputs . (#$(guix-input "guix-modular" "master")))

	(#:build-outputs . ()))

      '((#:name . "master")

        (#:load-path-inputs . ())

        (#:package-path-inputs . ())

        (#:proc-input . "guix")

        (#:proc-file . "build-aux/cuirass/gnu-system.scm")

        (#:proc . cuirass-jobs)

        (#:proc-args (subset . "all") (systems . ("x86_64-linux")))

        (#:inputs . (#$(guix-input "guix" "master")))

	(#:build-outputs . ()))))

(define (publish-locations url)

  "Return the nginx location blocks for 'guix publish' running on URL."

  (list (nginx-location-configuration

         (uri "/nix-cache-info")

         (body

          (list

           (string-append

            "proxy_pass " url "/nix-cache-info;")

           ;; Cache this file since that's always the first thing we ask

           ;; for.

           "proxy_cache static;"

           "proxy_cache_valid 200 100d;"     ; cache hits for a looong time.

           "proxy_cache_valid any 5m;"       ; cache misses/others for 5 min.

           "proxy_ignore_client_abort on;"

           ;; We need to hide and ignore the Set-Cookie header to enable

           ;; caching.

           "proxy_hide_header    Set-Cookie;"

           "proxy_ignore_headers Set-Cookie;")))

        (nginx-location-configuration

         (uri "/nar/")

         (body

          (list

           (string-append "proxy_pass " url ";")

           "client_body_buffer_size 256k;"

           ;; Be more tolerant of delays when fetching a nar.

           "proxy_read_timeout 60s;"

           "proxy_send_timeout 60s;"

           ;; Enable caching for nar files, to avoid reconstructing and

           ;; recompressing archives.

           "proxy_cache nar;"

           "proxy_cache_valid 200 30d;"           ; cache hits for 1 month

           "proxy_cache_valid 504 3m;" ; timeout, when hydra.gnu.org is overloaded

           "proxy_cache_valid any 1h;" ; cache misses/others for 1h.

           "proxy_ignore_client_abort on;"

           ;; Nars are already compressed.

           "gzip off;"

           ;; We need to hide and ignore the Set-Cookie header to enable

           ;; caching.

           "proxy_hide_header    Set-Cookie;"

           "proxy_ignore_headers Set-Cookie;"

           ;; Provide a 'content-length' header so that 'guix

           ;; substitute-binary' knows upfront how much it is downloading.

           ;; "add_header Content-Length $body_bytes_sent;"

           )))

        (nginx-location-configuration

         (uri "~ \\.narinfo$")

         (body

          (list

           ;; Since 'guix publish' has its own caching, and since it relies

           ;; on the atime of cached narinfos to determine whether a

           ;; narinfo can be removed from the cache, don't do any caching

           ;; here.

           (string-append "proxy_pass " url ";")

           ;; For HTTP pipelining.  This has a dramatic impact on

           ;; performance.

           "client_body_buffer_size 128k;"

           ;; Narinfos requests are short, serve many of them on a

           ;; connection.

           "keepalive_requests 600;"

           ;; Do not tolerate slowness of hydra.gnu.org when fetching

           ;; narinfos: better return 504 quickly than wait forever.

           "proxy_connect_timeout 2s;"

           "proxy_read_timeout 2s;"

           "proxy_send_timeout 2s;"

           ;; 'guix publish --ttl' produces a 'Cache-Control' header for

           ;; use by 'guix substitute'.  Let it through rather than use

           ;; nginx's "expire" directive since the expiration time defined

           ;; by 'guix publish' is the right one.

           "proxy_pass_header Cache-Control;"

           "proxy_ignore_client_abort on;"

           ;; We need to hide and ignore the Set-Cookie header to enable

           ;; caching.

           "proxy_hide_header    Set-Cookie;"

           "proxy_ignore_headers Set-Cookie;")))

        (nginx-location-configuration

         (uri "/log/")

         (body

          (list

           (string-append "proxy_pass " url ";")

           ;; Enable caching for build logs.

           "proxy_cache logs;"

           "proxy_cache_valid 200 60d;"           ; cache hits.

           "proxy_cache_valid 504 3m;" ; timeout, when hydra.gnu.org is overloaded

           "proxy_cache_valid any 1h;" ; cache misses/others.

           "proxy_ignore_client_abort on;"

           ;; We need to hide and ignore the Set-Cookie header to enable

           ;; caching.

           "proxy_hide_header    Set-Cookie;"

           "proxy_ignore_headers Set-Cookie;")))

        ;; Content-addressed files served by 'guix publish'.

        (nginx-location-configuration

         (uri "/file/")

         (body

          (list

           (string-append "proxy_pass " url ";")

           "proxy_cache cas;"

           "proxy_cache_valid 200 200d;"          ; cache hits

           "proxy_cache_valid any 5m;"            ; cache misses/others

           "proxy_ignore_client_abort on;")))))

(define (cuirass-locations publish-url)

  "Return nginx location blocks with 'guix publish' reachable at

PUBLISH-URL."

  (append (publish-locations publish-url)

          (list

           ;; Cuirass.

           (nginx-location-configuration

            (uri "/")

            (body (list "proxy_pass http://localhost:8081;")))

           (nginx-location-configuration

            (uri "~ ^/admin")

            (body

             (list "if ($ssl_client_verify != SUCCESS) { return 403; } proxy_pass http://localhost:8081;")))

           (nginx-location-configuration

            (uri "/static")

            (body

             (list

              "proxy_pass http://localhost:8081;"

              ;; Let browsers cache this for a while.

              "expires 10d;"

              ;; Cache quite aggressively.

              "proxy_cache static;"

              "proxy_cache_valid 200 5d;"

              "proxy_cache_valid any 10m;"

              "proxy_ignore_client_abort on;")))

           (nginx-location-configuration          ;certbot

            (uri "/.well-known")

            (body (list "root /var/www;")))

           (nginx-location-configuration

            (uri "/berlin.guixsd.org-export.pub")

            (body

             (list "root /var/www/guix;"))))))

(define %cuirass-extra-content

  (list

    "default_type application/octet-stream;"

    "sendfile on;"

    "sendfile_max_chunk 1m;"

    "keepalive_timeout  65;"

    "proxy_http_version 1.1;"

    ;; cache for nar files

    "proxy_cache_path /var/cache/nginx/nar"

    "     levels=2"

    "     inactive=8d"       ; inactive keys removed after 8d

    "     keys_zone=nar:4m"  ; nar cache meta data: ~32K keys

    "     max_size=10g;"     ; total cache data size max

    ;; cache for content-addressed-files

    "proxy_cache_path /var/cache/nginx/cas"

    "     levels=2"

    "     inactive=180d"     ; inactive keys removed after 180d

    "     keys_zone=cas:8m"  ; nar cache meta data: ~64K keys

    "     max_size=50g;"         ; total cache data size max

    ;; cache for build logs

    "proxy_cache_path /var/cache/nginx/logs"

    "     levels=2"

    "     inactive=60d"          ; inactive keys removed after 60d

    "     keys_zone=logs:8m"     ; narinfo meta data: ~64K keys

    "     max_size=4g;"          ; total cache data size max

    ;; cache for static data

    "proxy_cache_path /var/cache/nginx/static"

    "     levels=1"

    "     inactive=10d"         ; inactive keys removed after 10d

    "     keys_zone=static:1m"   ; nar cache meta data: ~8K keys

    "     max_size=200m;"        ; total cache data size max

    ;; Cache timeouts for a little while to avoid increasing pressure.

    "proxy_cache_valid 504 30s;"))

(define (cuirass-services root certificate key)

  (list

    (simple-service 'guix-http-server nginx-service-type

      (list (nginx-server-configuration

              (ssl-certificate certificate)

              (ssl-certificate-key key)

              (listen '("443 ssl http2" "[::]:443 ssl http2"))

              (server-name (list root))

              (locations (cuirass-locations %publish-url)))))

    (service guix-publish-service-type

      (guix-publish-configuration

        (compression '(("lzip" 3) ("gzip" 3)))

        (port %publish-port)))

    (service cuirass-service-type

      (cuirass-configuration

        (ttl (* 30 24 3600))

        (specifications %cuirass-specifications)))))