path: root/genenetwork-development.scm

;;; genenetwork-machines --- Guix configuration for genenetwork machines
;;; Copyright © 2022–2024 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2022–2024 Frederick Muriuki Muriithi <fredmanglis@gmail.com>
;;;
;;; This file is part of genenetwork-machines.
;;;
;;; genenetwork-machines 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.
;;;
;;; genenetwork-machines 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 genenetwork-machines.  If not, see
;;; <https://www.gnu.org/licenses/>.

(use-modules (gnu)
             ((gn packages genenetwork) #:select (genenetwork2 genenetwork3 gn-auth))
             (gn services databases)
             (gnu build linux-container)
             ((gnu packages admin) #:select (shepherd shadow))
             ((gnu packages base) #:select (gnu-make tar))
             ((gnu packages bash) #:select (bash))
             ((gnu packages bioinformatics) #:select (ccwl) #:prefix guix:)
             ((gnu packages certs) #:select (nss-certs))
             ((gnu packages check) #:select (python-pylint))
             ((gnu packages ci) #:select (laminar))
             ((gnu packages compression) #:select (gzip))
             ((gnu packages databases) #:select (mariadb virtuoso-ose))
             ((gnu packages gnupg) #:select (guile-gcrypt))
             ((gnu packages graphviz) #:select (graphviz))
             ((gnu packages guile) #:select (guile-3.0 guile-git guile-zlib))
             ((gnu packages guile-xyz) #:select (guile-dbd-mysql guile-dbi guile-dsv guile-hashing
                                                 guile-ini guile-lib guile-libyaml guile-smc guile-xapian))
             ((gnu packages guile-xyz) #:select (guile-sparql) #:prefix guix:)
             ((gnu packages haskell-apps) #:select (shellcheck))
             ((gnu packages python-check) #:select (python-mypy))
             ((gnu packages python-web) #:select (gunicorn))
             ((gnu packages rdf) #:select (raptor2))
             ((gnu packages tls) #:select (openssl))
             ((gnu packages version-control) #:select (git-minimal))
             ((gnu packages version-control) #:select (libgit2-1.3) #:prefix guix:)
             ((gnu packages web) #:select (tissue) #:prefix guix:)
             (gnu services ci)
             (gnu services databases)
             (gnu services mcron)
             (gnu services shepherd)
             ((gnu services web) #:select (nginx-server-configuration
                                           nginx-location-configuration))
             (gnu system file-systems)
             (guix build-system gnu)
             (guix channels)
             (guix ci)
             (guix git-download)
             (guix least-authority)
             ((guix licenses) #:prefix license:)
             (guix modules)
             (guix packages)
             (guix profiles)
             (guix records)
             (guix store)
             (guix utils)
             (forge acme)
             (forge cgit)
             (forge forge)
             (forge laminar)
             (forge nginx)
             (forge socket)
             (forge tissue)
             (forge utils)
             (forge webhook)
             (srfi srfi-1)
             (ice-9 match))

;; guix-daemon socket of the host shared inside the container
(define %guix-daemon-uri
  "/var/host-guix/daemon-socket/socket")

(define %default-guix-channel-with-substitutes
  (channel-with-substitutes-available %default-guix-channel
                                      "https://ci.guix.gnu.org"))

;; We cannot refer to sudo in the store since that sudo does not have
;; the setuid bit set. See "(guix) Setuid Programs".
(define sudo
  "/run/setuid-programs/sudo")

(define (manifest-cons package onto-manifest)
  "Return a manifest with PACKAGE and all packages in ONTO-MANIFEST."
  (manifest (cons (package->manifest-entry package)
                  (manifest-entries onto-manifest))))

(define (manifest-cons* . args)
  "ARGS is of the form (PACKAGES ... ONTO-MANIFEST). Return a manifest
with PACKAGES and all packages in ONTO-MANIFEST."
  (let ((packages (drop-right args 1))
        (onto-manifest (last args)))
    (manifest (append (map package->manifest-entry packages)
                      (manifest-entries onto-manifest)))))

(define (import-module? name)
  "Return #t if NAME, a list of symbols, denotes a module that should
be imported into G-expressions."
  ;; Allow all guix-forge, genenetwork or guix modules.
  (match name
    (((or 'forge 'genenetwork) _ ...) #t)
    (name (guix-module-name? name))))

(define-record-type* <genenetwork-configuration>
  genenetwork-configuration make-genenetwork-configuration
  genenetwork-configuration?
  (gn2-repository genenetwork-configuration-gn2-repository
                  (default "https://github.com/genenetwork/genenetwork2"))
  (gn3-repository genenetwork-configuration-gn3-repository
                  (default "https://github.com/genenetwork/genenetwork3"))
  (gn-auth-repository genenetwork-configuration-gn-auth-repository
                  (default "https://git.genenetwork.org/gn-auth"))
  (gn2-port genenetwork-configuration-gn2-port
            (default 8082))
  (gn3-port genenetwork-configuration-gn3-port
            (default 8083))
  (gn-auth-port genenetwork-configuration-gn-auth-port
            (default 8084))
  (gn2-secrets genenetwork-configuration-gn2-secrets
               (default "/etc/genenetwork/gn2-secrets.py"))
  (gn3-secrets genenetwork-configuration-gn3-secrets
               (default "/etc/genenetwork/gn3-secrets.py"))
  (gn-auth-secrets genenetwork-configuration-gn-auth-secrets
                   (default "/etc/genenetwork/gn-auth-secrets.py"))
  (genotype-files genenetwork-configuration-genotype-files
                  (default "/var/genenetwork/genotype-files"))
  (sparql-endpoint genenetwork-configuration-sparql-endpoint
                   (default "http://localhost:8081/sparql"))
  (data-directory genenetwork-data-directory
                  (default "/var/genenetwork"))
  (xapian-db-path genenetwork-xapian-db-path
                  (default "/var/genenetwork/xapian"))
  (auth-db-path genenetwork-auth-db-path
		(default "/export/data/genenetwork-sqlite/auth.db")))


;;;
;;; guix-bioinformatics
;;;

(define guix-bioinformatics-project
  (forge-project
   (name "guix-bioinformatics")
   (repository "/home/git/public/guix-bioinformatics")
   (description "Bioinformatics packages for GNU Guix")
   (ci-jobs (let ((channels (list (channel
                                   (name 'gn-bioinformatics)
                                   (url "https://git.genenetwork.org/guix-bioinformatics")
                                   (branch "master")))))
              (list (forge-laminar-job
                     (name "guix-bioinformatics")
                     (run (guix-channel-job-gexp channels
                                                 #:variables '()
                                                 #:guix-daemon-uri %guix-daemon-uri)))
                    (forge-laminar-job
                     (name "guix-bioinformatics-all-packages")
                     (run (guix-channel-job-gexp channels
                                                 #:verbose? #false
                                                 #:guix-daemon-uri %guix-daemon-uri))))))))


;;;
;;; genenetwork
;;;

(define (genenetwork2-tests config test-command)
  "Return a G-expression that runs TEST-COMMAND for genenetwork2
described by CONFIG, a <genenetwork-configuration>
object. TEST-COMMAND is a list of strings specifying the command to be
executed."
  (match-record config <genenetwork-configuration>
    (gn2-repository gn3-repository gn3-port genotype-files)
    (with-imported-modules '((guix build utils))
      (with-packages (list bash coreutils git-minimal nss-certs)
        #~(begin
            (use-modules (guix build utils))

            (define (hline)
              "Print a horizontal line 50 '=' characters long."
              (display (make-string 50 #\=))
              (newline)
              (force-output))

            (define (show-head-commit)
              (hline)
              (invoke "git" "log" "--max-count" "1")
              (hline))

            (invoke "git" "clone" "--depth" "1" #$gn3-repository)
            (with-directory-excursion "genenetwork3"
              (show-head-commit))
            (invoke "git" "clone" "--depth" "1" #$gn2-repository)
            (with-directory-excursion "genenetwork2"
              (show-head-commit))
            ;; This is a dummy SERVER_PORT to placate
            ;; bin/genenetwork2. TODO: Fix bin/genenetwork2 so that
            ;; this is not needed.
            (setenv "SERVER_PORT" "8080")
            ;; Use a profile with all dependencies except
            ;; genenetwork3.
            (setenv "GN2_PROFILE"
                    #$(profile
                       (content (package->development-manifest genenetwork2))
                       (allow-collisions? #t)))
            ;; Set GN3_PYTHONPATH to the latest genenetwork3.
            (setenv "GN3_PYTHONPATH"
                    (string-append (getcwd) "/genenetwork3"))
            (setenv "GN_PROXY_URL" "http://genenetwork.org/gn3-proxy/")
            (setenv "GN3_LOCAL_URL" (string-append "http://localhost:" (number->string #$gn3-port)))
            (setenv "GENENETWORK_FILES" #$genotype-files)
            (setenv "HOME" "/tmp")
            (setenv "SQL_URI" "mysql://webqtlout:webqtlout@localhost/db_webqtl")
            (chdir "genenetwork2")
            (apply invoke '#$test-command))))))

(define %xapian-directory
  "/export/data/genenetwork-xapian")

(define (build-xapian-index-gexp project)
  "Return a G-expression that builds and installs a Xapian index using
genenetwork3 source from the latest commit of @var{project}."
  (with-imported-modules '((guix build utils))
    (with-manifest (manifest-cons* git-minimal nss-certs
                                   (package->development-manifest genenetwork3))
      #~(begin
          (use-modules (guix build utils)
                       (srfi srfi-26))

          (invoke "git" "clone" "--depth" "1"
                  #$(forge-project-repository project)
                  ".")
          (let ((xapian-directory #$%xapian-directory)
                (xapian-build-directory (string-append #$%xapian-directory
                                                       "/build")))
            (dynamic-wind
              (const #t)
              (lambda ()
                ;; Build xapian index.
                (setenv "PYTHONPATH" (getcwd))
                (invoke "./scripts/index-genenetwork" xapian-build-directory
			"mysql://webqtlout:webqtlout@localhost/db_webqtl")
                ;; Stop genenetwork3, replace old xapian index and
                ;; start genenetwork3.
                (dynamic-wind
                  (cut invoke #$sudo #$(file-append shepherd "/bin/herd") "stop" "genenetwork3")
                  (lambda ()
                    (for-each (lambda (file)
                                (rename-file file (string-append xapian-directory "/" (basename file))))
                              (find-files xapian-build-directory)))
                  (cut invoke #$sudo #$(file-append shepherd "/bin/herd") "start" "genenetwork3")))
              (cut delete-file-recursively xapian-build-directory)))))))

;; G-expression that is configured in cron to trigger a rebuild of the
;; xapian index
(define build-xapian-index-cron-gexp
  (with-extensions (list guile-dsv guile-lib guile-xapian)
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils)
                       (dsv)
                       (xapian wrap)
                       (xapian xapian)
                       (ice-9 match)
                       (ice-9 popen)
                       (srfi srfi-26)
                       (srfi srfi-71)
                       (rnrs io ports))

          ;; guile-dbi does not support guile 3. So, we shell out to
          ;; mysql instead.
          (define (mysql-table-checksums user password database tables)
            "Return list of checksums for @var{tables} in MySQL
@var{database}. Authenticate with @var{user} and @var{password}."
            (let ((from to pids (pipeline `((#$(file-append mariadb "/bin/mysql")
                                               "--batch"
                                               ,(string-append "--user=" user)
                                               ,(string-append "--password=" password)
                                               ,database)))))
              (put-string to (string-append "CHECKSUM TABLES "
                                            (string-join tables ",")
                                            ";"))
              (close to)
              (match (dsv->scm from #\tab)
                ((header (tables checksums) ...)
                 (close from)
                 checksums))))

          (call-with-database #$%xapian-directory
            (lambda (db)
              (let ((tables (string-split (Database-get-metadata db "tables")
                                          #\space))
                    (checksums (map string->number
                                    (string-split (Database-get-metadata db "checksums")
                                                  #\space))))
                ;; Trigger xapian index rebuild when table checksums
                ;; in the index do not match with the SQL database and
                ;; there is no running build job.
                (unless (or (equal? (mysql-table-checksums "webqtlout" "webqtlout" "db_webqtl" tables)
                                    checksums)
                            (file-exists? (string-append #$%xapian-directory "/build")))
                  (setenv "LAMINAR_REASON" "Nightly xapian index rebuild")
                  (invoke #$(file-append laminar "/bin/laminarc")
                          "queue" "genenetwork3-build-xapian-index")))))))))

(define (genenetwork-projects config)
  "Return forge projects for genenetwork described by CONFIG, a
<genenetwork-configuration> object."
  (match-record config <genenetwork-configuration>
    (gn2-repository gn3-repository gn-auth-repository gn2-port)
    (list (forge-project
           (name "genenetwork2")
           (repository gn2-repository)
           (ci-jobs (list (forge-laminar-job
                           (name "genenetwork2")
                           (run (genenetwork2-tests
                                 config
                                 (list "sh" "bin/genenetwork2" "./gn2/default_settings.py"
                                       "-c" "-m" "pytest")))
                           ;; If unit tests pass, redeploy genenetwork2 and
                           ;; trigger Mechanical Rob.
                           (after (with-imported-modules '((guix build utils))
                                    #~(begin
                                        (use-modules (guix build utils))
                                        (when (string=? (getenv "RESULT") "success")
                                          (invoke #$sudo
                                                  #$(file-append shepherd "/bin/herd")
                                                  "restart" "genenetwork2")
                                          (invoke #$(file-append laminar "/bin/laminarc")
                                                  "queue" "genenetwork2-mechanical-rob"))))))
                          (forge-laminar-job
                           (name "genenetwork2-mechanical-rob")
                           (run (genenetwork2-tests
                                 config
                                 (list "sh" "bin/genenetwork2" "./gn2/default_settings.py"
                                       "-c" "test/requests/test-website.py"
                                       "--all" (string-append "http://localhost:" (number->string gn2-port)))))
                           (trigger? #f))))
           (ci-jobs-trigger 'webhook))
          (forge-project
           (name "genenetwork3")
           (repository gn3-repository)
           (ci-jobs (list (forge-laminar-job
                           (name "genenetwork3")
                           (run (guix-channel-job-gexp
                                 (list (channel
                                        (name 'genenetwork3)
                                        (url (forge-project-repository this-forge-project))
                                        (branch "main")))
                                 #:variables (list (variable-specification
                                                    (module '(genenetwork3-package))
                                                    (name 'genenetwork3)))
                                 #:guix-daemon-uri %guix-daemon-uri))
			   ;; If tests run successfully, redeploy
			   ;; genenetwork3 and trigger genenetwork2 tests.
			   (after (with-imported-modules '((guix build utils))
                                    #~(begin
                                        (use-modules (guix build utils))

                                        (when (string=? (getenv "RESULT") "success")
                                          (invoke #$sudo
                                                  #$(file-append shepherd "/bin/herd")
                                                  "restart" "genenetwork3")
                                          (invoke #$(file-append laminar "/bin/laminarc")
                                                  "queue" "genenetwork2"))))))
                          (forge-laminar-job
                           (name "genenetwork3-all-tests")
                           (run (guix-channel-job-gexp
                                 (list (channel
                                        (name 'genenetwork3)
                                        (url (forge-project-repository this-forge-project))
                                        (branch "main")))
                                 #:variables (list (variable-specification
                                                    (module '(genenetwork3-package))
                                                    (name 'genenetwork3-all-tests)))
                                 #:guix-daemon-uri %guix-daemon-uri)))
                          (forge-laminar-job
                           (name "genenetwork3-build-xapian-index")
                           (run (build-xapian-index-gexp this-forge-project))
                           (trigger? #f))))
           (ci-jobs-trigger 'webhook))
	  (forge-project
           (name "gn-auth")
           (repository gn-auth-repository)
           (ci-jobs (list (forge-laminar-job
                           (name "gn-auth")
                           (run (guix-channel-job-gexp
                                 (list (channel
                                        (name 'gn-auth)
                                        (url (forge-project-repository this-forge-project))
                                        (branch "main")))
                                 #:variables (list (variable-specification
                                                    (module '(gn-auth))
                                                    (name 'gn-auth)))
                                 #:guix-daemon-uri %guix-daemon-uri))
                           ;; If unit tests pass, restart the auth server.
			   (after (with-imported-modules '((guix build utils))
                                    #~(begin
                                        (use-modules (guix build utils))

                                        (when (string=? (getenv "RESULT") "success")
                                          (invoke #$sudo
                                                  #$(file-append shepherd "/bin/herd")
                                                  "restart" "gn-auth")
					  (invoke #$(file-append laminar "/bin/laminarc")
                                                  "queue" "genenetwork2"))))))
                          (forge-laminar-job
                           (name "gn-auth-all-tests")
                           (run (guix-channel-job-gexp
                                 (list (channel
                                        (name 'gn-auth)
                                        (url (forge-project-repository this-forge-project))
                                        (branch "main")))
                                 #:variables (list (variable-specification
                                                    (module '(gn-auth))
                                                    (name 'gn-auth-all-tests)))
                                 #:guix-daemon-uri %guix-daemon-uri)))))
           (ci-jobs-trigger 'webhook)))))

(define (genenetwork2-cd-gexp config)
  "Return a G-expression that runs the latest genenetwork2 development
server described by CONFIG, a <genenetwork-configuration> object."
  (match-record config <genenetwork-configuration>
    (gn2-repository gn3-repository gn2-port gn3-port gn2-secrets genotype-files)
    (with-packages (list coreutils git-minimal gunicorn nss-certs)
      (with-imported-modules '((guix build utils))
        #~(begin
            (use-modules (guix build utils)
                         (ice-9 match))

            (define (hline)
              "Print a horizontal line 50 '=' characters long."
              (display (make-string 50 #\=))
              (newline)
              (force-output))

            (define (show-head-commit)
              (hline)
              (invoke "git" "log" "--max-count" "1")
              (hline))

            ;; Clone the latest genenetwork2 and genenetwork3
            ;; repositories.
            (invoke "git" "clone" "--depth" "1" #$gn2-repository)
            (with-directory-excursion "genenetwork2"
              (show-head-commit))
            (invoke "git" "clone" "--depth" "1" #$gn3-repository)
            (with-directory-excursion "genenetwork3"
              (show-head-commit))

            ;; Override the genenetwork3 used by genenetwork2.
            (setenv "GN3_PYTHONPATH"
                    (string-append (getcwd) "/genenetwork3"))
            ;; Set other environment variables required by
            ;; genenetwork2.
            (setenv "SERVER_PORT" #$(number->string gn2-port))
            (setenv "GN2_PROFILE" #$(profile
                                     (content (package->development-manifest genenetwork2))
                                     (allow-collisions? #t)))
	    (setenv "GN_SERVER_URL" "https://cd.genenetwork.org/api3/")
	    (setenv "GN3_LOCAL_URL"
		    #$(string-append "http://localhost:"
				     (number->string gn3-port)))
            (setenv "GENENETWORK_FILES" #$genotype-files)
	    (setenv "SQL_URI" "mysql://webqtlout:webqtlout@localhost/db_webqtl")
            (setenv "HOME" "/tmp")
            (setenv "NO_REDIS" "no-redis")
	    (setenv "RUST_BACKTRACE" "1")

	    (setenv
	     "GN2_SETTINGS"
	     #$(mixed-text-file "gn2-staging.conf"
				"GN2_SECRETS=\"" gn2-secrets "\"\n"
				"GN3_LOCAL_URL=\""
				(string-append "http://localhost:"
					       (number->string gn3-port))
				"\"\n"
				"GN_SERVER_URL=\"https://cd.genenetwork.org/api3/\"\n"
				"AUTH_SERVER_URL=\"https://auth-cd.genenetwork.org/\"\n"
				"SQL_URI=\"mysql://webqtlout:webqtlout@localhost/db_webqtl\"\n"))

            ;; Start genenetwork2.
            (with-directory-excursion "genenetwork2"
              (invoke #$(file-append bash "/bin/sh")
                      "bin/genenetwork2" "gn2/default_settings.py" "-gunicorn-prod")))))))

(define (genenetwork3-cd-gexp config)
  "Return a G-expression that runs the latest genenetwork3 development
server described by CONFIG, a <genenetwork-configuration> object."
  (match-record config <genenetwork-configuration>
    (gn3-repository gn3-port gn3-secrets sparql-endpoint data-directory xapian-db-path auth-db-path)
    (with-manifest (package->development-manifest genenetwork3)
      (with-packages (list git-minimal nss-certs)
        (with-imported-modules '((guix build utils))
          #~(begin
              (use-modules (guix build utils)
                           (ice-9 match))

              (define (hline)
                "Print a horizontal line 50 '=' characters long."
                (display (make-string 50 #\=))
                (newline)
                (force-output))

              (define (show-head-commit)
                (hline)
                (invoke "git" "log" "--max-count" "1")
                (hline))

              ;; Clone the latest genenetwork3 repository.
              (invoke "git" "clone" "--depth" "1" #$gn3-repository)
              ;; Configure genenetwork3.
              (setenv "GN3_CONF"
                      #$(mixed-text-file "gn3.conf"
                                         "SPARQL_ENDPOINT=\"" sparql-endpoint "\"\n"
                                         "DATA_DIR=\"" data-directory "\"\n"
                                         "XAPIAN_DB_PATH=\"" xapian-db-path "\"\n"
					 "AUTH_DB=\"" auth-db-path "\"\n"))
              (setenv "HOME" "/tmp")
	      (setenv "GN3_SECRETS" #$gn3-secrets)
              ;; Run genenetwork3.
              (with-directory-excursion "genenetwork3"
                (show-head-commit)
                (invoke #$(file-append gunicorn "/bin/gunicorn")
                        "-b" #$(string-append "localhost:" (number->string gn3-port))
                        "--workers" "8"
                        "gn3.app:create_app()"
                        ;; gunicorn's default 30 second timeout is
                        ;; insufficient for Fahamu AI endpoints and
                        ;; results in worker timeout errors.
                        "--timeout" "1200"))))))))

(define (gn-auth-cd-gexp config)
  "Return a G-expression that runs the latest gn-auth development
server described by CONFIG, a <genenetwork-configuration> object."
  (match-record config <genenetwork-configuration>
    (gn-auth-repository gn-auth-port auth-db-path gn-auth-secrets)
    (with-manifest (package->development-manifest gn-auth)
      (with-packages (list git-minimal nss-certs)
        (with-imported-modules '((guix build utils))
          #~(begin
              (use-modules (guix build utils)
                           (ice-9 match))

              (define (hline)
                "Print a horizontal line 50 '=' characters long."
                (display (make-string 50 #\=))
                (newline)
                (force-output))

              (define (show-head-commit)
                (hline)
                (invoke "git" "log" "--max-count" "1")
                (hline))

              ;; Clone the latest gn-auth repository.
              (invoke "git" "clone" "--depth" "1" #$gn-auth-repository)
              ;; Configure gn-auth.
              (setenv "GN_AUTH_CONF"
                      #$(mixed-text-file "gn-auth.conf"
					 "AUTH_DB=\"" auth-db-path "\"\n"))
	      (setenv "GN_AUTH_SECRETS" #$gn-auth-secrets)
              (setenv "HOME" "/tmp")
	      (setenv "AUTHLIB_INSECURE_TRANSPORT" "true")
              ;; Run gn-auth.
              (with-directory-excursion "gn-auth"
                (show-head-commit)
                (invoke #$(file-append gunicorn "/bin/gunicorn")
                        "-b" #$(string-append "localhost:" (number->string gn-auth-port))
                        "--workers" "8"
                        "gn_auth:create_app()"))))))))

(define (genenetwork-shepherd-services config)
  "Return shepherd services to run the genenetwork development server
described by CONFIG, a <genenetwork-configuration> object."
  (match-record config <genenetwork-configuration>
    (gn2-port gn3-port gn-auth-port genotype-files data-directory xapian-db-path auth-db-path)
    (list (shepherd-service
           (documentation "Run GeneNetwork 2 development server.")
           (provision '(genenetwork2))
           ;; FIXME: The genenetwork2 service should depend on redis.
           (requirement '(networking genenetwork3))
           (start #~(make-forkexec-constructor
                     (list #$(least-authority-wrapper
                              (program-file "genenetwork2"
                                            (genenetwork2-cd-gexp config))
                              #:name "genenetwork2-pola-wrapper"
                              ;; If we mapped only the mysqld.sock
                              ;; socket file, it would break when the
                              ;; external mysqld server is restarted.
                              #:mappings (list (file-system-mapping
                                                (source genotype-files)
                                                (target source))
                                               (file-system-mapping
                                                (source "/run/mysqld")
                                                (target source)
                                                (writable? #t))
					       (file-system-mapping
                                                (source "/etc/genenetwork/conf/gn2")
                                                (target source)
                                                (writable? #t)))
                              #:namespaces (delq 'net %namespaces))
                           "127.0.0.1" #$(number->string gn2-port))
                     #:user "genenetwork"
                     #:group "genenetwork"
                     #:log-file "/var/log/cd/genenetwork2.log"))
           (stop #~(make-kill-destructor)))
          (shepherd-service
           (documentation "Run GeneNetwork 3 development server.")
           (provision '(genenetwork3))
           (requirement '(networking))
           (start #~(make-forkexec-constructor
                     (list #$(least-authority-wrapper
                              (program-file "genenetwork3"
                                            (genenetwork3-cd-gexp config))
                              #:name "genenetwork3-pola-wrapper"
                              ;; If we mapped only the mysqld.sock
                              ;; socket file, it would break when the
                              ;; external mysqld server is restarted.
                              #:mappings (list (file-system-mapping
                                                (source "/run/mysqld")
                                                (target source)
                                                (writable? #t))
                                               (file-system-mapping
                                                (source data-directory)
                                                (target source))
                                               (file-system-mapping
                                                (source xapian-db-path)
                                                (target source))
					       (file-system-mapping
                                                (source "/etc/genenetwork/conf/gn3")
                                                (target source)
                                                (writable? #t))
                                               (file-system-mapping
                                                (source auth-db-path)
                                                (target source)
                                                (writable? #t)))
                              #:namespaces (delq 'net %namespaces))
                           "127.0.0.1" #$(number->string gn3-port))
                     #:user "genenetwork"
                     #:group "genenetwork"
                     #:log-file "/var/log/cd/genenetwork3.log"))
           (stop #~(make-kill-destructor)))
	  (shepherd-service
           (documentation "Run gn-auth development server.")
           (provision '(gn-auth))
           (requirement '(networking))
           (start #~(make-forkexec-constructor
                     (list #$(least-authority-wrapper
                              (program-file "gn-auth"
                                            (gn-auth-cd-gexp config))
                              #:name "gn-auth-pola-wrapper"
                              ;; If we mapped only the mysqld.sock
                              ;; socket file, it would break when the
                              ;; external mysqld server is restarted.
                              #:mappings (list (file-system-mapping
                                                (source "/run/mysqld")
                                                (target source)
                                                (writable? #t))
                                               (file-system-mapping
                                                (source data-directory)
                                                (target source))
                                               (file-system-mapping
                                                (source auth-db-path)
                                                (target source)
                                                (writable? #t))
					       (file-system-mapping
                                                (source "/etc/genenetwork/conf/gn-auth")
                                                (target source)
                                                (writable? #t)))
                              #:namespaces (delq 'net %namespaces))
                           "127.0.0.1" #$(number->string gn-auth-port))
                     #:user "genenetwork"
                     #:group "genenetwork"
                     #:log-file "/var/log/cd/gn-auth.log"))
           (stop #~(make-kill-destructor))))))

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

(define (genenetwork-activation config)
  (match-record config <genenetwork-configuration>
    (gn2-secrets gn3-secrets auth-db-path)
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils))

          ;; Set ownership of files.
          (for-each (lambda (file)
                      (chown file
                             (passwd:uid (getpw "genenetwork"))
                             (passwd:gid (getpw "genenetwork"))))
                    (cons* #$gn2-secrets
                           #$gn3-secrets
                           (find-files #$(dirname auth-db-path)
                                       #:directories? #t)))
          ;; Prevent other users from reading secret files.
          (for-each (lambda (file)
                      (chmod file #o600))
                    (list #$gn2-secrets
                          #$gn3-secrets))))))

(define genenetwork-service-type
  (service-type
   (name 'genenetwork)
   (description "Run GeneNetwork development servers and CI.")
   (extensions
    (list (service-extension account-service-type
                             (const %genenetwork-accounts))
          (service-extension activation-service-type
                             genenetwork-activation)
          (service-extension shepherd-root-service-type
                             genenetwork-shepherd-services)
          (service-extension forge-service-type
                             genenetwork-projects)))
   (default-value (genenetwork-configuration))))


;;;
;;; transform-genenetwork-database
;;;

;; Path to genenetwork database dump export directory that has lots of
;; free space
(define %transform-genenetwork-database-export-directory
  "/export/genenetwork-database-dump")

;; Unreleased version of ccwl that is required by
;; transform-genenetwork-database for its graphql library.
(define ccwl
  (let ((commit "02677a508b407779f5991a230341e016deb7f69b")
        (revision "0"))
    (package
      (inherit guix:ccwl)
      (name "ccwl")
      (version (git-version (package-version guix:ccwl) revision commit))
      (source
       (origin
         (method git-fetch)
         (uri (git-reference
               (url "https://github.com/arunisaac/ccwl")
               (commit commit)))
         (file-name (git-file-name name version))
         (sha256
          (base32
           "1kxry8y0pibl0x789jrzqkkh2s59ajyinfvrgvd00gkbqldih82r")))))))

;; guile-sparql tests are broken. Disable them temporarily. The issue
;; has been reported upstream at
;; https://github.com/roelj/guile-sparql/issues/6
(define guile-sparql
  (package
    (inherit guix:guile-sparql)
    (arguments
     `(#:tests? #f))))

;; Temporarily package run64 here until it can be contributed to
;; upstream Guix.
(define run64
  (package
    (name "run64")
    (version "0.1.0")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url "https://git.systemreboot.net/run64")
                    (commit "a271723e3938b158aa6748e8befceb114b84c6df")))
              (file-name (git-file-name name version))
              (sha256
               (base32
                "1kdx8h2x5a4cp8azzy1v2xgyb2153sakb1wbi2rj5ygkpmasygbm"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags (list (string-append "prefix=" %output))
       #:phases
       (modify-phases %standard-phases
         (delete 'configure))))
    (home-page "https://run64.systemreboot.net")
    (synopsis "SRFI-64 test runner for Scheme")
    (description "run64 is a SRFI-64 test runner for Scheme.")
    (license license:gpl3+)))

(define (transform-genenetwork-database project)
  (with-imported-modules '((guix build utils))
    (with-packages (list ccwl git-minimal gnu-make guile-3.0 guile-dbd-mysql
                         guile-dbi guile-hashing guile-libyaml guile-sparql
                         guile-zlib nss-certs virtuoso-ose)
      #~(begin
          (use-modules (guix build utils)
                       (srfi srfi-26)
                       (ice-9 threads))

          (invoke "git" "clone"
                  "--depth" "1"
                  #$(forge-project-repository project)
                  ".")
          (invoke "make" "-j" (number->string (current-processor-count)))
          (let ((connection-settings-file #$(string-append %transform-genenetwork-database-export-directory
                                                           "/conn.scm"))
                (dump-directory #$(string-append %transform-genenetwork-database-export-directory
                                                 "/dump")))
            (when (file-exists? dump-directory)
              (delete-file-recursively dump-directory))
            (mkdir-p dump-directory)
            ;; Dump data to RDF.
            (invoke "./pre-inst-env" "./dump.scm"
                    connection-settings-file
                    dump-directory)
            ;; Validate dumped RDF, sending the error output to
            ;; oblivion because we don't want to print out potentially
            ;; sensitive data.
            (with-error-to-file "/dev/null"
              (cut invoke
                   #$(file-append raptor2 "/bin/rapper")
                   "--input" "turtle"
                   "--count"
                   (string-append dump-directory "/dump.ttl")))
            ;; Load RDF into virtuoso.
            (invoke "./pre-inst-env" "./load-rdf.scm"
                    connection-settings-file
                    (string-append dump-directory "/dump.ttl"))
            ;; Visualize schema and archive results.
            (invoke "./pre-inst-env" "./visualize-schema.scm"
                    connection-settings-file)
            (invoke #$(file-append graphviz "/bin/dot")
                    "-Tsvg" "sql.dot" (string-append "-o" (getenv "ARCHIVE") "/sql.svg"))
            (invoke #$(file-append graphviz "/bin/dot")
                    "-Tsvg" "rdf.dot" (string-append "-o" (getenv "ARCHIVE") "/rdf.svg")))))))

(define transform-genenetwork-database-project
  (forge-project
   (name "transform-genenetwork-database")
   (repository "/home/git/public/gn-transform-databases/")
   (ci-jobs (list (forge-laminar-job
                   (name "transform-genenetwork-database-tests")
                   (run (guix-channel-job-gexp
                         (list (channel
                                (name 'transform-genenetwork-database)
                                (url (forge-project-repository this-forge-project))
                                (branch "master"))
                               %default-guix-channel-with-substitutes)
                         #:guix-daemon-uri %guix-daemon-uri)))
                  (forge-laminar-job
                   (name "transform-genenetwork-database")
                   (run (transform-genenetwork-database this-forge-project)))))))


;;;
;;; gn-gemtext-threads
;;;

(define gn-gemtext-threads-project
  (forge-project
   (name "gn-gemtext-threads")
   (repository "https://github.com/genenetwork/gn-gemtext-threads/")
   (ci-jobs (list (forge-laminar-job
                   (name "gn-gemtext-threads")
                   (run (with-packages (list nss-certs openssl)
                          (with-imported-modules '((guix build utils))
                            #~(begin
                                (use-modules (guix build utils))

                                (invoke #$(file-append tissue "/bin/tissue")
                                        "pull" "issues.genenetwork.org"))))))))
   (ci-jobs-trigger 'webhook)))


;;;
;;; guile-lmdb
;;;

(define guile-lmdb-project
  (forge-project
   (name "guile-lmdb")
   (repository "https://github.com/aartaka/guile-lmdb")
   (ci-jobs (list (forge-laminar-job
                   (name "guile-lmdb")
                   (run (guix-channel-job-gexp
                         (list (channel
                                (name 'guile-lmdb)
                                (url (forge-project-repository this-forge-project))
                                (branch "master"))
                               %default-guix-channel-with-substitutes)
                         #:guix-daemon-uri %guix-daemon-uri)))))
   (ci-jobs-trigger 'webhook)))


;;;
;;; operating-system definition
;;;

(define (laminar-template-gexp issue-tracker-uri)
  "Return a G-expression that creates a custom Laminar template with a
menu link to channels.scm and the issue tracker at ISSUE-TRACKER-URI."
  (with-imported-modules '((guix build utils))
    #~(begin
        (use-modules (guix build utils))

        (copy-file (string-append #$(package-source laminar) "/src/resources/index.html")
                   #$output)
        (substitute* #$output
          (("<router-link to=\"jobs\">Jobs</router-link>" jobs-link)
           (string-append
            "<a href=\"https://cd.genenetwork.org\" target=\"_blank\">CD</a>"
            jobs-link
            "<a href=\"" #$issue-tracker-uri "\" target=\"_blank\">Issues</a>"
            "<a href=\"/channels.scm\" target=\"_blank\">channels.scm</a>"))))))

(define (install-laminar-template-gexp template)
  "Return a G-expression that installs custom laminar TEMPLATE."
  (with-imported-modules '((guix build utils))
    #~(begin
        (use-modules (guix build utils))

        (mkdir-p "/var/lib/laminar/custom")
        (switch-symlinks "/var/lib/laminar/custom/index.html" #$template))))

(define %ci-domain
  "ci.genenetwork.org")

(define (cd-error-pages-gexp)
  "Return a G-expression that builds a directory with error pages for
the GeneNetwork continuous deployment."
  (with-imported-modules '((guix build utils))
    (with-extensions (list guile-lib)
      #~(begin
          (use-modules (guix build utils)
                       (htmlprag))

          (define (ci-badge job)
            `(div (a (@ (href ,(string-append "https://" #$%ci-domain "/jobs/" job)))
                     (img (@ (src ,(string-append "https://" #$%ci-domain "/badge/" job ".svg")))))))

          (define (page-sxml jobs)
            `(html
              (head
               (title "GeneNetwork CD down!"))
              (body
               (h1 "GeneNetwork CD is down!")
               (p "Is the CI red?")
               ,@(map ci-badge jobs))))

          (mkdir-p (string-append #$output "/error"))
          (call-with-output-file (string-append #$output "/error/502.html")
            (lambda (port)
              (display "<!DOCTYPE html>" port)
              (newline port)
              (display
               (sxml->html
                ;; Construct a 502 page pulling out CI job names using a
                ;; dummy default genenetwork configuration.
                (page-sxml '#$(append-map (lambda (project)
                                            (map forge-laminar-job-name
                                                 (forge-project-ci-jobs project)))
                                          (genenetwork-projects
                                           (genenetwork-configuration)))))
               port)
              (newline port)))))))

(define (channels-scm-gexp published-channel-names)
  "Return a G-expression that builds a directory with a channels.scm
file to be served by the laminar reverse
proxy. PUBLISHED-CHANNEL-NAMES is a list of names of channels which
should be included in the channels.scm file."
  (with-imported-modules '((guix build utils))
    #~(begin
        (use-modules (ice-9 pretty-print)
                     (guix build utils))

        (mkdir-p #$output)
        (call-with-output-file (string-append #$output "/channels.scm")
          (lambda (port)
            (pretty-print
             '#$`(list ,@(filter-map (lambda (channel)
                                       (and (memq (channel-name channel)
                                                  published-channel-names)
                                            (channel->code channel)))
                                     (profile-channels
                                      ;; Infer profile from guix
                                      ;; executable used.
                                      (match (program-arguments)
                                        ((program . _)
                                         (dirname (dirname program)))))))
             port))))))

(define (development-server-reverse-proxy-server-block gn2-port gn3-port)
  "Return an <nginx-server-configuration> object to reverse proxy the
GeneNetwork development server. GN2-PORT and GN3-PORT are the ports
GeneNetwork2 and GeneNetwork3 are listening on."
  (nginx-server-configuration
   (server-name '("cd.genenetwork.org"))
   (locations
    (list (nginx-location-configuration
           ;; Reverse proxy genenetwork2.
           (uri "/")
           (body (list (string-append "proxy_pass http://localhost:"
                                      (number->string gn2-port) ";")
                       "proxy_set_header Host $host;"
		       "proxy_set_header X-Forwarded-Proto $scheme;")))
          (nginx-location-configuration
           ;; Reverse proxy genenetwork3.
           (uri "/api3")
           (body (list "rewrite /api3/(.*) /api/$1 break;"
                       (string-append "proxy_pass http://localhost:"
                                      (number->string gn3-port) ";")
                       "proxy_set_header Host $host;")))
          (nginx-location-configuration
           (uri " /error/")
           (body (list #~(string-append
                          "root "
                          #$(computed-file "genenetwork-cd-error-pages"
                                           (cd-error-pages-gexp))
                          ";"))))))
   (raw-content (list "error_page 502 /error/502.html;"))))

(define (laminar-reverse-proxy-server-block laminar-bind-http webhook-port published-channel-names)
  "Return an <nginx-server-configuration> object to reverse proxy
laminar. The nginx server will reverse proxy to laminar listening on
LAMINAR-BIND-HTTP. WEBHOOK-PORT is the port the webhook server is
listening on. PUBLISHED-CHANNEL-NAMES is a list of channel names for
which a channels.scm should be published."
  (nginx-server-configuration
   (server-name (list %ci-domain))
   (locations
    (list (nginx-location-configuration
           (uri "/")
           (body (list (string-append "proxy_pass http://" laminar-bind-http ";")
                       ;; Disable proxy buffering in host's nginx. We
                       ;; need this to allow Laminar's Server-Sent
                       ;; Events to pass through.
                       "proxy_pass_header X-Accel-Buffering;")))
          ;; Reverse proxy webhook server.
          (nginx-location-configuration
           (uri "/hooks/")
           (body (list (string-append "proxy_pass http://localhost:"
                                      (number->string webhook-port) ";")
                       "proxy_set_header Host $host;")))
          ;; Publish the channels.scm used to build this container.
          (nginx-location-configuration
           (uri "= /channels.scm")
           (body (list #~(string-append
                          "root "
                          #$(computed-file "channels.scm"
                                           (channels-scm-gexp published-channel-names))
                          ";"))))))))

;; Port on which tissue is listening
(define %tissue-port 9083)

(define (tissue-reverse-proxy-server-block)
  "Return an <nginx-server-configuration> object to reverse proxy
tissue."
  (nginx-server-configuration
   (server-name '("issues.genenetwork.org"))
   (root "/var/lib/tissue/issues.genenetwork.org/website")
   (try-files (list "$uri" "$uri.html" "@tissue-search"))
   (locations
    (list (nginx-location-configuration
           (uri "@tissue-search")
           (body (list (string-append "proxy_pass http://localhost:" (number->string %tissue-port) ";")
                       "proxy_set_header Host $host;")))))))

(define (gn-auth-reverse-proxy-server-block)
  "Return an <nginx-server-configuration> object to reverse proxy
gn-auth."
  (nginx-server-configuration
   (server-name '("auth-cd.genenetwork.org"))
   (locations
    (list (nginx-location-configuration
	   (uri "/")
           (body (list (string-append "proxy_pass http://localhost:"
				      (number->string %gn-auth-port)
				      ";")
                       "proxy_set_header Host $host;")))))))

;; Port on which webhook is listening
(define %webhook-port 9091)
;; Port on which genenetwork2 is listening
(define %genenetwork2-port 9092)
;; Port on which genenetwork3 is listening
(define %genenetwork3-port 9093)
;; Port on which gn-auth is listening
(define %gn-auth-port 9094)
;; Port on which virtuoso's SPARQL endpoint is listening
(define %virtuoso-sparql-port 9082)

(operating-system
  (host-name "genenetwork-development")
  (timezone "UTC")
  (locale "en_US.utf8")
  (bootloader (bootloader-configuration
               (bootloader grub-bootloader)
               (targets (list "/dev/sdX"))))
  (file-systems %base-file-systems)
  (users %base-user-accounts)
  (packages %base-packages)
  (sudoers-file
   (mixed-text-file "sudoers"
                    "@include " %sudoers-specification
                    ;; Permit the laminar user to restart genenetwork2
                    ;; and genenetwork3.
                    "\nlaminar ALL = NOPASSWD: "
                    (file-append shepherd "/bin/herd") " restart genenetwork2, "
                    (file-append shepherd "/bin/herd") " start genenetwork3, "
                    (file-append shepherd "/bin/herd") " stop genenetwork3, "
                    (file-append shepherd "/bin/herd") " restart genenetwork3,"
                    (file-append shepherd "/bin/herd") " start gn-auth, "
                    (file-append shepherd "/bin/herd") " stop gn-auth, "
                    (file-append shepherd "/bin/herd") " restart gn-auth\n"
                    ;; Permit the acme user to restart nginx.
                    "\nacme ALL = NOPASSWD: " (file-append shepherd "/bin/herd") " restart nginx\n"))
  (services (cons* (service forge-service-type
                            (forge-configuration
                             (projects (list transform-genenetwork-database-project
                                             gn-gemtext-threads-project
                                             guile-lmdb-project
                                             guix-bioinformatics-project))))
                   (service cgit-service-type
                            (cgit-configuration
                             (server-name "git.genenetwork.org")
                             (repository-directory "/home/git/public")))
                   (service laminar-service-type
                            (laminar-configuration
                             (title "GeneNetwork CI")
                             (bind-http "localhost:9089")))
                   (service mcron-service-type
                            (mcron-configuration
                             (jobs (list #~(job '(next-hour)
                                                #$(program-file "build-xapian-index-cron"
                                                                build-xapian-index-cron-gexp)
                                                #:user "laminar")))))
                   (simple-service 'install-laminar-template
                                   activation-service-type
                                   (install-laminar-template-gexp
                                    (computed-file
                                     "laminar-template.html"
                                     (laminar-template-gexp "https://issues.genenetwork.org"))))
                   (service webhook-service-type
                            (webhook-configuration
                             (socket (forge-ip-socket
                                      (ip "127.0.0.1")
                                      (port %webhook-port)))))
                   (service redis-service-type)
                   (service virtuoso-service-type
                            (virtuoso-configuration
			     (number-of-buffers 4000000)
			     (maximum-dirty-buffers 3000000)
                             (server-port 9081)
			     (dirs-allowed "/var/lib/data")
                             (http-server-port %virtuoso-sparql-port)))
                   (service genenetwork-service-type
                            (genenetwork-configuration
                             (gn2-port %genenetwork2-port)
                             (gn3-port %genenetwork3-port)
			     (gn-auth-port %gn-auth-port)
                             (gn2-secrets "/etc/genenetwork/conf/gn2/secrets.py")
                             (gn3-secrets "/etc/genenetwork/conf/gn3/secrets.py")
                             (gn-auth-secrets "/etc/genenetwork/conf/gn-auth/secrets.py")
                             (genotype-files "/export/data/genenetwork/genotype_files")
                             (sparql-endpoint (string-append "http://localhost:"
                                                             (number->string %virtuoso-sparql-port)
                                                             "/sparql"))
                             (data-directory "/export/data/genenetwork")
                             (xapian-db-path %xapian-directory)))
                   (simple-service 'set-build-directory-permissions
                                   activation-service-type
                                   (with-imported-modules '((guix build utils))
                                     #~(begin
                                         (use-modules (guix build utils))

                                         (for-each (lambda (file)
                                                     (chown file
                                                            (passwd:uid (getpw "laminar"))
                                                            (passwd:gid (getpw "laminar"))))
                                                   (append (find-files #$%xapian-directory
                                                                       #:directories? #t)
                                                           (find-files #$%transform-genenetwork-database-export-directory
                                                                       #:directories? #t))))))
                   (service tissue-service-type
                            (tissue-configuration
                             (socket
                              (forge-ip-socket
                               (port %tissue-port)))
                             (hosts
                              (list (tissue-host
                                     (name "issues.genenetwork.org")
                                     (user "laminar")
                                     (upstream-repository "https://github.com/genenetwork/gn-gemtext-threads"))))))
                   (service forge-nginx-service-type
                            (forge-nginx-configuration
                             (http-listen (forge-ip-socket
                                           (ip "0.0.0.0")
                                           (port 9080)))
                             (https-listen (forge-ip-socket
                                            (ip "0.0.0.0")
                                            (port 9090)))
                             (server-blocks
                              (list (development-server-reverse-proxy-server-block
                                     %genenetwork2-port %genenetwork3-port)
                                    (laminar-reverse-proxy-server-block
                                     "localhost:9089" %webhook-port
                                     (list 'gn-bioinformatics))
                                    (tissue-reverse-proxy-server-block)
				    (gn-auth-reverse-proxy-server-block)))))
                   (service acme-service-type
                            (acme-configuration
                             (email "arunisaac@systemreboot.net")))
                   %base-services)))