;;; GNU Guix system administration tools.

;;;

;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>

;;;

;;; 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/>.

;;; NOTE: this file is taken from

;;; https://git.savannah.gnu.org/cgit/guix/maintenance.git/plain/hydra/modules/sysadmin/web.scm

(define-module (config static-web)

  #:use-module (guix git)

  #:use-module (guix gexp)

  #:use-module (guix modules)

  #:use-module (guix packages)

  #:use-module (guix records)

  #:use-module (guix git-download)

  #:use-module (gnu packages)

  #:use-module (gnu packages autotools)

  #:use-module (gnu packages graphviz)

  #:use-module (gnu packages guile)

  #:use-module (gnu packages guile-xyz)

  #:use-module (gnu packages package-management)

  #:use-module (gnu packages pkg-config)

  #:use-module (gnu packages texinfo)

  #:use-module (gnu services)

  #:use-module (gnu services mcron)

  #:use-module (gnu services shepherd)

  #:use-module (gnu services web)

  #:use-module (gnu system shadow)

  #:use-module (ice-9 match)

  #:export (build-program

            static-web-site-configuration

            static-web-site-configuration?

            static-web-site-service-type))

(define guix-extensions

  (match (package-transitive-propagated-inputs

          (specification->package "guix"))

    (((labels packages) ...)

     (cons (specification->package "guix") packages))))

(define* (build-program url root

                        #:key

                        (file "guix.scm")

                        (ref '(branch . "master"))

                        (name "build-program")

                        (environment-variables '())

                        (cache-directory #f))

  "Return a program that pulls code from URL, builds it by loading FILE from

that checkout (usually a 'guix.scm' file), and registers the result as

ROOT (an indirect GC root) upon success.  FILE is loaded in a content where

ENVIRONMENT-VARIABLES, a list of key/value pairs, are defined.

The typical use case is polling from the source repository of a web site

that's built with Haunt or similar."

  (define build

    (with-extensions guix-extensions

      #~(begin

          (use-modules (guix) (guix git) (guix ui)

                       (srfi srfi-11) (ice-9 match))

          (define (root-installed drv root)

            (mbegin %store-monad

              ((store-lift add-indirect-root) root)

              (let ((pivot (string-append root ".tmp")))

                (symlink (derivation->output-path drv) pivot)

                (rename-file pivot root)

                (return #t))))

          (define cache

            (and=> #$cache-directory

                   (lambda (directory)

                     ;; Interpret DIRECTORY as relative to $HOME/.cache.

                     (string-append (%repository-cache-directory)

                                    "/" directory))))

          (define-values (checkout commit relation)

            (apply update-cached-checkout #$url #:ref '#$ref

                   (if cache

                       `(#:cache-directory ,cache)

                       '())))

          (define obj

            (let ((variables '#$environment-variables))

              (for-each (match-lambda

                          ((name . value)

                           (setenv name value)))

                        variables)

              (primitive-load (string-append checkout "/" #$file))))

          (with-store store

            (run-with-store store

              (mlet %store-monad ((drv (lower-object obj)))

                (mbegin %store-monad

                  (show-what-to-build* (list drv))

                  (built-derivations (list drv))

                  (root-installed drv #$root))))))))

  (program-file name build

                #:guile guile-3.0-latest))

;;;

;;; Service.

;;;

(define-record-type* <static-web-site-configuration>

  static-web-site-configuration make-static-web-site-configuration

  static-web-site-configuration?

  (git-url     static-web-site-configuration-git-url)

  (git-ref     static-web-site-configuration-git-ref

               (default '(branch . "master")))

  (build-file  static-web-site-configuration-build-file

               (default "guix.scm"))

  (environment-variables static-web-site-configuration-environment-variable

                         (default '()))

  (cache-directory static-web-site-configuration-cache-directory

                   (default #f))

  (directory   static-web-site-configuration-directory

               (default "/srv/www")))

(define (static-web-site-mcron-jobs config)

  (define update

    (build-program (static-web-site-configuration-git-url config)

                   (static-web-site-configuration-directory config)

                   #:file (static-web-site-configuration-build-file config)

                   #:ref (static-web-site-configuration-git-ref config)

                   #:environment-variables

                   (static-web-site-configuration-environment-variable config)

                   #:cache-directory

                   (static-web-site-configuration-cache-directory config)

                   #:name (string-append

                           "update-"

                           (basename

                            (static-web-site-configuration-directory config)))))

  (list #~(job '(next-minute '(0)) #$update

               #:user "static-web-site")))

(define (static-web-site-activation config)

  (with-imported-modules '((guix build utils))

    #~(begin

        (use-modules (guix build utils))

        (let ((directory (dirname

                          #$(static-web-site-configuration-directory config))))

          (mkdir-p directory)

          (chown directory

                 (passwd:uid (getpw "static-web-site"))

                 (group:gid (getgr "static-web-site")))))))

(define (static-web-site-accounts config)

  (list (user-account

         (name "static-web-site")

         (group "static-web-site")

         (system? #t))

        (user-group

         (name "static-web-site")

         (system? #t))))

(define static-web-site-service-type

  (service-type (name 'static-web-site)

                (extensions

                 ;; TODO: Extend nginx directly from here?

                 (list (service-extension mcron-service-type

                                          static-web-site-mcron-jobs)

                       (service-extension account-service-type

                                          static-web-site-accounts)

                       (service-extension activation-service-type

                                          static-web-site-activation)))

                (description

                 "Update and publish a web site that is built from source

taken from a Git repository.")))