path: root/genenetwork-development.scm

;;; genenetwork-machines --- Guix configuration for genenetwork machines
;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2022, 2023 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 packages quality-control) #:select (sbcl-qc))
             (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 (virtuoso-ose yoyo-migrations))
             ((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-hashing guile-lib guile-libyaml))
             ((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 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")

;; 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"))
  (gn2-port genenetwork-configuration-gn2-port
            (default 8082))
  (gn3-port genenetwork-configuration-gn3-port
            (default 8083))
  (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 "https://git.genenetwork.org/guix-bioinformatics")
   (description "Bioinformatics packages for GNU Guix")
   (ci-jobs (list (forge-laminar-job
                   (name "guix-bioinformatics")
                   (run (guix-channel-job-gexp
                         (list (channel
                                (name 'gn-bioinformatics)
                                (url "https://gitlab.com/genenetwork/guix-bioinformatics")
                                (branch "master")))
                         #:verbose? #false
                         #:guix-daemon-uri %guix-daemon-uri)))))
   (ci-jobs-trigger 'webhook)))


;;;
;;; 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 (genenetwork3-tests tests-command manifest)
  "Return a G-expression running TESTS-COMMAND in a profile described
by MANIFEST with the latest git checkout of genenetwork3 as the
current directory. TESTS-COMMAND is a list of strings specifying the
command to be executed."
  (with-imported-modules (source-module-closure '((genenetwork development-helper))
                                                #:select? import-module?)
    #~(lambda (genenetwork3-checkout)
        ((@@ (genenetwork development-helper)
             command-in-source-gexp)
         genenetwork3-checkout
         #$(profile
            (content manifest)
            (allow-collisions? #t))
         '#$tests-command))))

(define genenetwork3-unit-tests
  (genenetwork3-tests (list "pytest" "-k" "unit_test")
                      (package->development-manifest genenetwork3)))

(define (genenetwork3-auth-migrations-genenetwork config)
  "Return a G-expression that runs the migrations for the
auth(entic|oris)ation database. This is the actual migration run by
the genenetwork user."
  (match-record config <genenetwork-configuration>
    (auth-db-path)
    (with-imported-modules '((guix build utils))
      #~(begin
	  (use-modules (guix build utils))

          ;; Initialize an empty database file if it does not
          ;; already exist.
          (unless (file-exists? #$auth-db-path)
	    (call-with-output-file #$auth-db-path
              (const #t)))
          ;; Run migrations.
	  (invoke #$(file-append yoyo-migrations "/bin/yoyo")
		  "apply" "--config"
		  #$(mixed-text-file
		     "yoyo.ini"
		     "[DEFAULT]\n"
		     "sources = genenetwork3/migrations/auth/\n"
		     "database = sqlite:///" auth-db-path "\n"
		     "migration_table = _yoyo_migration\n"
		     "batch_mode = on\n"
		     "verbosity = 2"))))))

(define (genenetwork3-auth-migrations-laminar config)
  "Return a G-expression that runs the migrations for the
auth(entic|oris)ation database. This is the wrapper script run by the
laminar user."
  (match-record config <genenetwork-configuration>
    (gn3-repository)
    (with-packages (list git-minimal nss-certs)
      (with-imported-modules '((guix build utils))
        #~(begin
            (use-modules (guix build utils))

            ;; Clone the latest genenetwork3 repository.
            (invoke "git" "clone" "--depth" "1" #$gn3-repository)
            ;; Run the actual migrations as the genenetwork user.
            (invoke #$sudo "--user=genenetwork"
                    #$(program-file "genenetwork3-auth-migrations"
                                    (genenetwork3-auth-migrations-genenetwork config))))))))

(define genenetwork3-pylint
  (with-imported-modules (source-module-closure '((genenetwork development-helper))
                                                #:select? import-module?)
    #~(lambda (genenetwork3-checkout)
        ((@@ (genenetwork development-helper)
             genenetwork3-lint-gexp)
         genenetwork3-checkout
         #$(profile
            (content (manifest-cons* python-pylint shellcheck
                                     (package->development-manifest genenetwork3)))
            (allow-collisions? #t))))))

(define genenetwork3-mypy
  (genenetwork3-tests (list "mypy" ".")
                      (manifest-cons python-mypy
                                     (package->development-manifest genenetwork3))))

(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)))))))

(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 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" "./etc/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" "./etc/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
                                 (cons (channel
                                        (name 'genenetwork3)
                                        (url (forge-project-repository this-forge-project))
                                        (branch "main"))
                                       %default-channels)
                                 #:guix-daemon-uri %guix-daemon-uri))
                           ;; If unit tests pass, trigger the auth migrations.
                           (after (with-imported-modules '((guix build utils))
                                    #~(begin
                                        (use-modules (guix build utils))

                                        (when (string=? (getenv "RESULT") "success")
                                          (invoke #$(file-append laminar "/bin/laminarc")
                                                  "queue" "genenetwork3-auth-migrations"))))))
                          (forge-laminar-job
                           (name "genenetwork3-pylint")
                           (run (derivation-job-gexp
                                 this-forge-project
                                 this-forge-laminar-job
                                 genenetwork3-pylint
                                 #:guix-daemon-uri %guix-daemon-uri)))
                          (forge-laminar-job
                           (name "genenetwork3-mypy")
                           (run (derivation-job-gexp
                                 this-forge-project
                                 this-forge-laminar-job
                                 genenetwork3-mypy
                                 #:guix-daemon-uri %guix-daemon-uri)))
                          (forge-laminar-job
			   (name "genenetwork3-auth-migrations")
			   (run (genenetwork3-auth-migrations-laminar config))
			   ;; If migrations 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")))))
			   (trigger? #f))
                          (forge-laminar-job
                           (name "genenetwork3-build-xapian-index")
                           (run (build-xapian-index-gexp this-forge-project))
                           (trigger? #f))))
           (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 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_PROXY_URL" "http://genenetwork.org/gn3-proxy/")
            (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")

            ;; Start genenetwork2.
            (with-directory-excursion "genenetwork2"
              (invoke #$(file-append bash "/bin/sh")
                      "bin/genenetwork2" "etc/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 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")
              ;; Run genenetwork3.
              (with-directory-excursion "genenetwork3"
                (show-head-commit)
                (invoke #$(file-append gunicorn "/bin/gunicorn")
                        "-b" #$(string-append "localhost:" (number->string gn3-port))
                        "gn3.app: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 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)))
                              #: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 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))))))

(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>
    (auth-db-path)
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils))

          (for-each (lambda (file)
                      (chown file
                             (passwd:uid (getpw "genenetwork"))
                             (passwd:gid (getpw "genenetwork"))))
                    (find-files #$(dirname auth-db-path)
                                #:directories? #t))))))

(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))))


;;;
;;; qc
;;; 

(define qc-tests
  (with-imported-modules (cons '(guix build lisp-utils)
                               (source-module-closure '((genenetwork development-helper))
                                                      #:select? import-module?))
    #~(lambda (source)
        ((@@ (genenetwork development-helper)
             asdf-test-gexp)
         source
         #$(profile
            (content (package->development-manifest sbcl-qc))
            (allow-collisions? #t))
         "qc" (list "qc.asd")))))

(define qc-project
  (forge-project
   (name "qc")
   (repository "https://git.genenetwork.org/jgart/qc")
   (ci-jobs (list (forge-laminar-job
                   (name "qc")
                   (run (derivation-job-gexp
                         this-forge-project
                         this-forge-laminar-job
                         qc-tests
                         #:guix-daemon-uri %guix-daemon-uri)))))
   (ci-jobs-trigger 'webhook)))


;;;
;;; dump-genenetwork-database
;;; 

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

;; Unreleased version of ccwl that is required by
;; dump-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 dump-genenetwork-database-tests
  (with-imported-modules (source-module-closure '((genenetwork development-helper))
                                                #:select? import-module?)
    #~(lambda (source)
        ((@@ (genenetwork development-helper)
             command-in-source-gexp)
         source
         #$(profile
            (content (packages->manifest
                      (list gnu-make guile-3.0 guile-dbi guile-dbd-mysql
                            ccwl guile-libyaml guile-sparql run64)))
            (allow-collisions? #t))
         (list "make" "check")))))

(define (dump-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 %dump-genenetwork-database-export-directory
                                                           "/conn.scm"))
                (dump-directory #$(string-append %dump-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 dump-genenetwork-database-project
  (forge-project
   (name "dump-genenetwork-database")
   (repository "https://github.com/genenetwork/dump-genenetwork-database")
   (ci-jobs (list (forge-laminar-job
                   (name "dump-genenetwork-database-tests")
                   (run (derivation-job-gexp
                         this-forge-project
                         this-forge-laminar-job
                         dump-genenetwork-database-tests
                         #:guix-daemon-uri %guix-daemon-uri)))
                  (forge-laminar-job
                   (name "dump-genenetwork-database")
                   (run (dump-genenetwork-database this-forge-project)))))
   (ci-jobs-trigger 'webhook)))

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

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

        (define (switch-symlinks link target)
          (let ((pivot (string-append link ".new")))
            (symlink target pivot)
            (rename-file pivot link)))

        (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
                                      (or (getenv "GUIX_PROFILE")
                                          (string-append %profile-directory "/current-guix")))))
             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;")))
          (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;")))))))

;; 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 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\n"
                    ;; Permit the laminar user to run auth db
                    ;; migrations as the genenetwork user.
                    "\nlaminar ALL = (genenetwork) NOPASSWD: "
                    (program-file "genenetwork3-auth-migrations"
                                  (genenetwork3-auth-migrations-genenetwork (genenetwork-configuration)))
                    ;; 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 qc-project
                                             dump-genenetwork-database-project
                                             gn-gemtext-threads-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-day)
                                                #$(program-file "build-xapian-index-cron"
                                                                (with-imported-modules '((guix build utils))
                                                                  #~(begin
                                                                      (use-modules (guix build utils))
                                                                      (setenv "LAMINAR_REASON" "Nightly xapian index rebuild")
                                                                      (invoke #$(file-append laminar "/bin/laminarc")
                                                                              "queue" "genenetwork3-build-xapian-index"))))
                                                #: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)
                             (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 #$%dump-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)))))
                   (service acme-service-type
                            (acme-configuration
                             (email "arunisaac@systemreboot.net")))
                   %base-services)))