;;; 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.")))